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THE  FIRST  CONFERENCE  OF  USERS  OF 
THE  MAGIC  AND  SAM-C  PROGRAMS 


1.  INTRODUCTION  AND  PURPOSE 

This  report  presents  the  proceedings  of  the  first  large-scale 
conference  of  the  users  of  the  MAGIC  and  SAM-C  computer  programs.  The 
conference  convened  at  0915  on  August  6,  1969,  in  Building  328  at 
Aberdeen  Proving  Ground,  Maryland.  Early  in  the  afternoon  of  the  7th 
the  conferees  divided  themselves  into  two  groups:  those  interested  in 
the  MAGIC  code  and  those  interested  in  the  SAM-C.  The  conference  closed 
shortly  after  noon  on  Friday  the  8th. 

The  following  sections  contain  abridged  versions  of  the  an¬ 
nouncement  letter  and  of  the  opening  address. 

1. 1  Copy  of  Conference  Announcement  (Abridged) . 

"AMXRD-AWF 

"SUBJECT:  Conference  for  Users  of  the  MAGIC/SAM-C  Computer  Programs 


"1.  References: 

a.  The  MAGIC  SAM-C  Target  Analysis  Technique,  AMSAA  Technical 
Reports  4,  10,  11,  13,  and  14. 

b.  A  Geometric  Description  Technique  Suitable  for  Computer 
Analysis  of  Both  the  Nuclear  and  Conventional  Vulnerability  of  Armored 
Military  Vehicles,  MAGI-6701  (AD  847576). 

c.  UNC-SAM-2:  A  FORTRAN  Monte  Carlo  Program  Treating  Time- 
Dependent  Neutron  and  Photon  Transport  Through  Matter,  UNC--5157 
(AD  647470). 

"2.  The  SAM-C  Monte  Carlo  radiation  transport  program  and  the  MAGIC 
conventional  projectile  ray-tracing  program  were  developed  by  MAGI 
(Mathematical  Applications  Group,  Inc)  under  Contract  No.  DAAD05-67-C- 
0041  for  this  agency  (ref.  a) .  MAGIC  is  the  computer  code  that  assem¬ 
bles  data  along  selected  rays  through  a  target  by  employing  the  MAGI  1 
originated  Combinatorial  Geometry  technique  (ref.  b)  which  utilizes 
combinations  of  certain  basic  solids  such  as  boxes,  wedges,  etc. ,  to 
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describe  the  target.  SAM-C  is  the  UNC-SAM-2  Monte  Carlo  nuclear  radia¬ 
tion  transport  code  (ref.  c)  with  the  original  geometry  routines  re¬ 
placed  by  those  of  the  Combinatorial  Geometry  technique.  These  programs 
have  been  disseminated  to  a  number  of  interested  government  agencies 
for  their  use  and  will  be  made  available  to  others  upon  request. 

"3.  Recent  activity  with  MAGIC  has  resulted  in  several  advances  includ¬ 
ing  the  addition  of  new  "library"  solids,  additional  input  checking,  and 
faster  input  processing.  These  advances  are  clearly  applicable  to  SAM-C 
as  well  and  are  thus  of  general  interest  to  both  groups.  On  the  other 
hand,  recent  activity  with  SAM-C  indicates  that  the  flux-at-a-point 
routine  is  incorrectly  coded,  versions  for  different  computing  systems 
have  non-trivial  differences  in  logic/organization,  and  the  computa¬ 
tional  procedure  for  carrying  out  a  complete  set  of  calculations  is 
unacceptably  complicated. 

"4.  As  a  result  of  the  many  questions,  comments,  and  suggestions  from 
the  personnel  involved  in  using  SAM-C/MAGIC,  it  is  clear  that  everyone 
involved  can  benefit  from  an  informal  discussion  of  problem  areas  and 
a  concerted  attack  on  areas  of  mutual  interest.  It  is  the  purpose  of 
this  letter  to  announce  an  informal,  unclassified  conference  t.o  define 
and  solve  problems  in  the  MAGIC  and  SAM-C  computer  codes  developed  under 
the  auspices  of  this  agency. 

"5.  It  is  envisioned  that  the  conference  will  begin  on  6  August  1969  at 
0900  hours  in  the  Conference  Room  of  ARDC  Building  328  under  the  chair¬ 
manship  cf  Mr.  R.  A.  Marking  of  AMSAA.  At  this  writing  it  is  envisioned 
that  2  days  will  be  required  with  a  third  day  allotted  only  to  provide 
a  buffer  period. 

"6.  The  first  day  will  be  devoted  to  introductory,  informal  discussions 
of  individual  problems,  solutions,  and  changes  to  the  various  codes  plus 
presentations  (on  MAGIC  by  Mr.  Larry  Bain,  Methodology  Office,  AMSAA, 
and  on  SAM-C  by  Dr.  Wayne  Coleman,  Nuclear  Physics  Branch,  NEL)  of 
information  gathered  too  late  for  inclusion  into  the  reports  of  reference 
a.  The  item,  "Introduction  of  Participants,"  is  envisioned  as  an  oppor¬ 
tunity  for  each  participant  to  identify  which  program(s)  his  agency  is 
using,  what  problems  have  been  encountered,  any  solutions  that  have  been 
created,  and  what  specific  problem  areas  he  would  like  to  see  addressed 
during  the  conference  period.  About  20  minutes  will  be  allotted  for 
each  individual. 

"7.  The  second  day  is  planned  for  the  creation  of  ad  hoc  working  groups 
to  achieve  solutions  of  the  problems  defined  on  the  first  day.  An  addi¬ 
tional  day  is  scheduled  to  allow  an  orderly  conclusion  of  the  working 
group  projects  and  the  conference  as  a  whole  if  necessary;  the  form  and 
content  of  a  conference  report  will  be  decided  on  the  last  day. 


8 


"8.  Two  items  have  been  of  special  interest  to  all  those  contacted  thus 
far:  (1)  the  establishment  of  FORTRAN  source  decks  for  MAGIC  and  SAM-C 
that  are  not  subject  to  the  vagaries  of  day-to-day  changes  and  are  avail¬ 
able  to  be  copied  by  new  user  agencies  or  in  the  event  that  serious  prob¬ 
lems  develop  with  an  existing  source  deck;  and  (2)  the  creation  of 
"benchmark"  test  problems  that  will  provide  valid  tests  of  all  features/ 
options  operational  using  the  ''archival"  or  "library"  source  deck.  It 
is  expected  that  these  two  items  can  be  introduced  in  the  afternoon  of 
the  first  day  of  the  conference. 

"9.  Participation  in  the  conference  is  encouraged  to  promote  the  utility 
of  the  SAM-C  and  MAGIC  programs.  Representation  from  your  organization 
is  invited.  The  distribution  list  is  not  considered  exhaustive  and  in¬ 
terested  personnel  within  government  may  be  invited  to  attend  by  con¬ 
tacting  Mr.  Marking.  Participants  are  encouraged  to  bring  listings  of 
the  current  working  versions  of  their  program(s). 

"10.  It  is  intended  that  the  meeting  will  result  in  documented  improve¬ 
ments  in  the  SAM-C  and  MAGIC  source  programs  and/or  implementation  pro¬ 
cedures.  This  documentation  is  expected  to  be  in  the  form  of  a  letter 
or  technical  note  and  copies  will  be  sent  to  all  participants. 

"11.  The  desirability  of  scheduling  similar  meetings  at  regular  inter¬ 
vals  will  be  discussed  as  a  means  of  maintaining  lines  of  communications 
between  MAGIC-SAM-C  users." 

1 2 .  (Admin istrative) 

13.  (Administrative) 

FOR  THE  DIRECTOR: 


/s/  Morgan  G.  Smith 
MORGAN  G.  SMITH 
Chief,  Ground  Warfare  Division 

1  Incl 

as 

(CF) 
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PROPOSED  CONFERENCE  AGENDA 


DAY  1 

" In t induction  and  Purpose 
Introduction  of  Participants 
Recent  AMSAA  Activity  with  MAGIC 
Recent  NEL  Activity  with  SAM-C 
Definition  of  MAGIC  and  SAM-C  Capabilities  and 
Creation  of  Appropriate  Source  Decks 
Creation  of  Benchmark  Problems 

DAY  2 

Conclusion  of  the  Creation  of  Archival  Source 
Decks  and  Benchmark  Problems 

Formation  of  Sub-groups  to  Solve  the  Problems 
Defined  on  Day  1 

Discussion  and  Drafting  of  Documentation 
Consideration  of  Future  Meetings 

DAY  3  (If  Necessary) 

Conclusion  of  Unfinished  Business" 


Incl  1  to  ltr 
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1.2 


Opening  Address. 


"Welcome  to  the  1st  Conference  of  Users  of  the  MAGIC  and  SAM-C 

Programs. 


"As  stated  in  the  Conference  letter-announcement,  this  is  to 
be  an  informal,  unclassified  conference  of  the  users  of  the  MAGIC  and/or 
SAM-C  computer  programs  (as  well  as  any  of  the  peripheral  programs  that 
might  be  of  mutual  interest). 

"The  purpose  of  this  conference  is  three-fold: 

•  to  find  out  where  we  stand  with  respect  to  the  actual 

operation  of  both  SAM-C  and  MAGIC 

-  who  is  using  what 

-  on  what  machines  are  the  codes  operating 

-  what  changes  of  substance  (e.g. ,  packing  into  36-bit  v. 
48-bit  words)  have  been  made 

-  what  kinds  of  problem  areas  are  being  considered  (e.g. , 
deep  penetration  as  opposed  to  close-in  transport  prob¬ 
lems,  penetrator  fragmentation,  x-ray  or  thermal  neutron 
problems,  etc. ) 

-  what  sort  of  functional  and/or  theoretical  problems  are 
being  encountered  in  operating  these  codes  (e.g. ,  func¬ 
tional  identifiers  of  "0",  incorrect  evaluation  of  the 
uncollided  flux,  improper  coding  of  SAM-C  for  inelastic 
scattering,  etc. ) 

•  to  define  what  SAM-C  and  MAGIC  should  be  capable  of 

-  there  are  a  number  of  versions  of  SAM-C  several  of  which 
are  different  enough  to  require  separate  operating 
manuals 

-  changes  have  significantly  increased  the  speed  of  MAGIC 
thus  making  here-to-fore  impractical  applications  worth 
considering 

-  should  SAM-C  be  modified  along  the  lines  of  UNC-SAM-3 
(ENDF/B  cross-sections  and  a  non-common  energy  mesh) 

-  should  MAGIC  calculate  vulnerable  areas 

-  should  the  geometry  processing  routines  (e.g. ,  GENI, 
RPPIN,  ALBERT,  etc.)  be  called  MAGIC  and  the  "driving" 
or  controlling  routines  such  as  VOLUM  and  GRID  be 
handled  as  separate  "packages" 

-  should  MAGIC  employ  packing  and  what  effect  would  its 
absence  have  on  SAM-C 
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•  to  create  benchmark  problems 

-  compatibility  of  geometric  input  between  MAGIC  and  SAM-C 

-  should  they  be  mathematical  tests  of  all  the  options  or 
tests  of  physical  acceptability  of  some  combination  of 
both. ..." 


2.  INTRODUCTION  OF  PARTICIPANTS 

At  the  beginning  of  the  Conference  the  individual  participants 
indicated  (1)  which  program  they  were  using,  (2)  on  which  computers  was 
it  routinely  used  (or  intended  to  be  used) ,  (3)  what  were  the  nature 
and  complexity  of  the  problems  treated,  (4)  what  program  innovations 
had  been  made,  and  (S)  what  problems  or  errors  had  been  encountered. 
Additionally,  it  was  requested  that  participants  indicate  specific 
program  problems  to  discuss  during  the  Conference. 

To  accomplish  these  introductions  in  an  orderly  manner,  a 
form  covering  all  of  the  obvious  points  of  interest  was  used.  Since 
some  of  the  agencies  were  represented  by  more  than  one  person,  represent¬ 
atives  from  the  same  group  using  the  same  program  caucused  to  present  a 
unified  picture  of  their  work  and  problems. 

The  participants*  introductions  follow  the  list  of  agencies; 
they  are  in  alphabetical  order. 


List  of  Agencies  Represented 


Aeronautical  Systems  Division 
(Wright-Patterson) 

Air  Force  Armament  Laboratory 
(Eglin) 

Air  Force  Weapons  Laboratory 
(Kirtland) 

Ground  Warfare  Division  (AMSAA) 
(Aberdeen) 

Methodology  Office  (AMSAA) 
(Aberdeen) 

Naval  Weapons  Laboratory* 
(Dahlgren) 

Nuclear  Effects  Laboratory  (BRL)* 
(Edgewood) 


No  Participant  Introduction  Form  available. 


12 


List  of  Agencies  Represented  (Cont'd) 

SMUPA-DW6* 

(Picatinny) 

SMUPA-SS 

(Picatinny) 

SMUPA-TW3 

(Picatinny) 

SMUPA-VC1 

(Picatinny) 

RS1C  (ORNL) 

(Oak  Ridge) 

it  it 

Signature  fj  Propagation  Laboratory 
(Aberdeen) 

it 

Tei-minal  3alli sties  Laboratory  (BRL) 
(Aberdeen) 

Vulnerability  Laboratory  (BRL) 
(Aberdeen) 


No  Participant  Introduction  Form  available. 

Observer  only,  no  Participant  Introduction  Form  included. 
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PARTICIPANT  INTRODUCTION  FORM 


Agency :  USAF,  ASD  (ASBRS) ,  WPAFB ,  Ohio  45433 

Name(s)  of  Representative (s) :  Gerald  Bennett  (ASBRS) 

Roy  Hilbrand  (ASVCP) 


Program  Used:  MAG  I C 

Purpose:  To  provide  target  descriptions  for  use  in  aircraft  vulnera¬ 
bility  analyses. 

Computer (s)  Used:  Name  IBM  Direct  Coupled  7044/7094  Word  Size  36  bits 
Memory  Site:  Total  32768  Available  Unk 

Tape  Drives:  No.  16  No.  of  Channels  4  1401-Compatible?  Yes 

Program  Requirements :  Storage  28K  Packed  Word  Size  35  bits 

Tape  Drives  2  Links?  Yes ,  1 
Dependence  on  Assembly  Language  None 

Planned  Program  Usage:  To  generate  target  description  for  aircraft 
vulnerable  area  computation. 

Planned  Program  Changes:  Addition  of  plotting,  presented  area,  and 
volume  subroutines;  modifications  as  required  to  generate  and  store 
data  for  efficient  processing  in  vulnerable  area  computation  program; 
further  simplifications,  as  possible,  to  input  descriptive  data. 

Program  Innovations:  The  use  of  any  body  as  a  target  volume  subdivision 
(i.e.  ,  as  an  RPP) ;  the  streamlining  of  MAGIC  by  stripping  out  about  16 
of  the  subroutines  and  recoding  of  others;  restructuring  of  the  Master- 
Aster  array  (M-A)  deleting  some  items  from  the  M-A  array;  recoding  and 
repacking  for  36  bit  words,  viz. ,  35  bits  and  one  sign  bit;  changed 
grid  cell  generation;  changed  printout;  allowing  the  attack  plane  to 
be  outside  of  the  enclosing  volume;  and  disposal  of  random  number 
generator  requirement. 

Program  Problems/Errors:  Core  storage  (too  large) ;  complexity  in 
preparation  of  data.  (Various  program  errors  have  been  corrected  and 
the  corrected  listings  have  been  forwarded  to  AMSAA.) 

Program  Changes  of  Immediate  Interest:  Addition  of  an  airfoil  shape  to 
the  solid  library;  a  more  extensive  ARB  of  perhaps  10  to  12  sides; 
introduction  of  "canned"  standard  aircraft  component  descriptions 
(e.g. ,  a  pilot) . 
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PARTICIPANT  INTRODUCTION  FORM 


Agency :  Air  Force  Armament  Laboratory 
Name(s)  of  Representative (s) :  Sue  Gibson 
Program  Used:  MAGIC 

Purpose :  To  be  used  with  a  vulnerable  area  program  to  produce  vulner¬ 
able  area  program  to  produce  vulnerable  areas  of  foreign  targets. 

Computer (s)  Used:  Name  CDC  6600  Word  Size  60  bits 

Memory  Size:  Total  100,000  Available  32,000 

Tape  Drives;  No.  16  No.  of  Channels  Unk  1401-Compatible?  No 

Program  Requirements :  Storage  32,000  Packed  Word  Size  36  bits 

Tape  Drives  7  Links?  Yes,  4 
Dependence  on  Assembly  Language  None 

Planned  Program  Usage:  Describe  foreign  air  and  ground  targets  in  terms 
of  line  of  sight  data. 

Planned  Program  Changes:  Complete  conversion  from  IBM  7094  to  CDC  6600. 
Omit  TESTG  and  other  unnecessary  subroutines  to  allow  room  for  addition 
of  new  figure  subroutines. 

Program  Innovations:  Point  Burst  subroutine  has  been  added  and  is  being 
checked. 

Program  Problems/Errors:  Lack  of  storage  due  to  amount  of  storage 
allowed  to  each  user,  not  to  the  total  amount  of  storage  in  the  CDC 
6600. 

Program  Changes  of  Immediate  Interest:  Addition  of  new  figures  and 
reduction  of  amount  of  storage  required. 
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PARTICIPANT  INTRODUCTION  FORM 

Agency :  AFWL,  Kirtiand  AFB,  New  Mexico  87117 

Namc(s)  of  Representative(s) :  Michael  J.  Paul  -  AFWL  (WLRAS) 

A.  Kris  Widdison  -  AFWL  (WLCP-M) 

Program  Used:  SAM-C 

Purpose :  Both  deep-penetration  (in  air)  and  close-in  transport 
(concrete)  problems,  primarily  neutrons,  but  including  prompt  and 
secondary  gammas. 

Computer (s)  Used:  Name  CDC  6600  Word  Size  60  bits 

Memory  Site:  Total  300K  (w/o  extended  core)  Available  lMg 
(w/extended  core)  • 325Kg  (w/o  extended  core) 

Tape  Drives:  No.  10  No.  of  Channels  9  1401-Compatible?  Unk 


Program  Requirements; 


Storage  generally  120K  Packed  Word  Size  45  or 
Tape  Drives  1-3  Links?  None  ^ 


Dependence  on  Assembly  Language  some,  but  easily 

changed 


Planned  Program  Usage:  Hard-rock  silo  configurations  and  state-of-art 
neutron  and  gamma  transport  problems. 

Planned  Program  Changes:  Complete  revision  of  input  to  be  more  under¬ 
standable  and  logical  and  easier  to  punch.  Combined  time-energy-angular 
dependent  source  input  (allowing  input  of  flux  from  a  preliminary  dis¬ 
crete  ordinates  code) . 

Program  Innovations:  Free-form  reading  routine  (eliminates  need  for 
formatting  input).  Cut  down  flux  printing  by  50%  by  eliminating  ex¬ 
traneous  lines  (e. g. ,  AE) .  Eliminate  need  to  change  NXS  =  ....  and 
NDQ. . . .  cards  (e.g.,  add  a  parameter,  say  ENDM,  to  end  of  master  array 
(COMMON  DUM  (250)  ,  MASTER  (30000) ,  ENDM) ,  then  NDQ  =  L0CF  (ENDM)  - 
LOCF  (Master)). 

Program  Problems/Errors:  None . 

Program  Changes  of  Immediate  Interest:  ENDF/B  cross  sections,  inelastic 
scattering  improvements;  graphic  geometry  display;  better  geometry 
checking. 


PARTICIPANT  INTRODUCTION  FORM 


Agency :  AMSAA,  Ground  Warfare  Division  (GWD) ;  Methodology  Office  (MO) 
Aberdeen  Proving  Ground,  Maryland  21005 

Name(s)  of  Representative (s) :  L.  Bain  (MO) 

R.  Lake  (GWD) 

J.  Brewer  (GWD) 


Program  Used:  MAGIC 

Purpose :  Conventional  vulnerability  by  4"  cells  and/or  areas  for 
combat  vehicles  and  aircraft. 

Computer(s)  Used:  Name  BRLESC  I  §  II  Word  Size  68  bits 
Memory  Size;  Total  96K  Available  48K 

Tape  Drives:  No.  8  No.  of  Channels  4  1401-Compatible?  Yes 

Program  Requirements :  Storage  48  Packed  Word  Size  50 

Tape  Drives  4  Links?  No 

Dependence  on  Assembly  Language  Yes  but  easily 

avoided 

Planned  Program  Usage:  Conventional  vulnerability  of  combat  vehicles  and 
aircraft  (both  rotary  and  fixed  wing  types) . 

Planned  Program  Changes: 

1)  Thirty  bit  packing  for  triplets  and  scalars. 

2)  Shielded  areas. 

Program  Innovations:  Rewrite  program  flow  to  minimize  presence  of 
unnecessary  steps,  extraneous  comments,  and  blank  cards. 

Program  Problems /Errors:  None . 

Program  Changes  of  Immediate  Interest:  No  genuinely  pressing  problems. 


PARTICIPANT  INTRODUCTION  FORM 


Agency :  Picatinny  Arsenal,  Dover,  N.  J. 

Name(s)  or  Representative (s) :  Robert  Kesselman  -  VC-1 

John  Saarmann  -  VC-1 
Robert  Bamas  -  SS 
John  Burgio  -  TW3 

Program  Used:  SAM-C  NEL  Version 

Purpose :  To  obtain  running  version  on  IBM  360  for  radiation  transport 
and  shielding  calculations. 

Computer (s)  Used:  Name  IBM  360  Word  Size  32/64  bits 
Memory  Size:  Total  Unk  Available  200K 

Tape  Drives:  No.  8  No.  of  Channels  9  1401-Compatible?  Yes 

Program  Requirements:  Storage  200K  Packed  Word  Size  64  bits 

Tape  Drives  3  Links?  Unk 

Dependence  on  Assembly  Language  one  subroutine 
Planned  Program  Usage:  Transport  and  Shielding 

Planned  Program  Changes:  In  January  1970  Picatinny  Arsenal  will  start 
using  CDC  6500;  therefore,  the  debugging  effort  on  the  conversion  has 
been  suspended. 

Program  Innovations :  (See  comment  above.) 

Program  Problems/Errors:  (See  comment  above.) 

Program  Changes  of  Immediate  Interest:  (See  comment  above.) 
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PARTICIPANT  INTRODUCTION  FORM 
(Observer) 

Agency:  Radiation  Shielding  Information  Center 
Oak  Ridge  National  Laboratory  i 
P.  0.  Box  X 

Oak  Ridge,  Tennessee  37330  ■  ! 

Name(s)  of  Representative (s) :  Robert  W.  Roussin  ' 

Program  Used:  SAM-C  , 

1  J  *  j 

Purpose :  For  distribution  to  anyone  who  wants  the  program.  (RSIC 
operations  are  sponsored  by  the  AEC,  DASA,  and  NASA.)  1 

We  have  the  CDC  6600  version  for  distribution  (but  no  6600  at  ORNL) 

Computer (s)  Used:  Name  Word  Size  ' •  ■ 

•  > 

Memory  Size:  Available 

Tape  Drives :  No.  of  Channels  .  1401-Compatible? 

Program  Requirements :  Storage  Packed  Word,  Size 

Tape  Drives  Links? 

Dependence  on  Assembly  Language 

*  1 

Planned  Program  Usage:  .  '  , 

Planned  Program  Changes : 

i 

Program  Innovations  We  are  Interested  In: 

1)  IBM  360  version. 

2)  Version  with  ENDF/B  .cross  sections.  •  ■  , 

Program  Problems/Errors:  '■ 


Program  Changes  of  Immediate  Interest: 


PARTICIPANT  INTRODUCTION  FORM 


Agency:  BRL,  Vulnerability  Laboratory,  Aberdeen  Proving  Ground,  Md.  21005 


M.  J.  Reisinger 


Program  Used: 


MAGIC 


Purpose :  Currently  being  used  to  debug  target  descriptions  for 
Electronics  Command,  Army  Tank  Automotive  Command,  Missile  Command, 
Munitions  Command,  Weapons  Command,  Nuclear  Effects  Laboratory,  Test 
&  Evaluation  Command  and  Falcon  Research  5  Development. 


Computer (s)  Used:  Name  8RLESC  Word  Size  68  bits 
Memory  Size:  Total  120K  Available  80K 

Tape  Drives :  No.  3  No.  of  Channels  7/9  1401-Compatible?  Yes 


Program  Requirements :  Storage  48  Packed  Word  Size  30 

Tape  Drives  4  Links?  No 

Dependence  on  Assembly  Language  Depends  on  version 


Planned  Program  Usage: 


1)  "Graphic  Program"  being  developed  from  NASA  program  by  L.  Bain 
and  M.  J.  Reisinger. 

2)  Recognition  of  heat  projectile  improper  detonation  from  target 
description. 

3)  Point  burst  program  with  emphasis  on  components. 


Planned  Program  Changes:  Generalized  Ellipsoid  (i.e. ,  not  restricted 
to  ellipsoids  of  revolution).  Elimination  of  enter-leave  table  philos 
ophy  in  favor  of  a  more  direct  approach  which-  is  intended  to  reduce 
tracking  time. 


Program  Innovations :  Graphics  Package. 

Program  Problems/Errors :  A  more  detailed  description  of  targets  than 
done  in  the  past  (example,  M60A1  with  approximately  2500  bodies)  is 
rapidly  approaching  our  computer  system  time  and  size  limit:  t'  1300 
body  description  is  using  64K,  will  2500  bodies  use  less  than  the 
available  80K?  Computer  time  on  our  system  forces  partial  runs  for 
graphics  (need  about  four  hours,  large  memory).  Summation:  need  better 
computer. 


Program  Changes  of  Immediate  Interest: 


1)  Development  of  support  subroutines  such  as  generalized  compo¬ 
nents  (wheels,  ammunition,  engine,  etc.)  that  require  location, 
orientation,  and  relative  size  that  lead  to  computer  generated 
bodies  (solids) . 

2)  Development  of  programs  that  would  construct  the  optimized 
solid  for  a  body  from  an  input  consisting  of  point  data  read 
directly  from  engineering  drawings. 


3.  RECENT  ACTIVITY  WITH  MAGIC  AND  SAM-C 


The  three  sections  that  follow  consist  of  the  material  pre¬ 
sented  verbally  at  the  conference  plus  one  or  two  minor  additions  or 
modifications. 

3.1  Recent  Activity  with  MAGIC  at  AMSAA.  (Presentation  by 
Larry  Bain) 

The  recent  activity  with  MAGIC  at  AMSAA  falls  into  one  of  two 
categories:  program  changes  or  proposed  plans.  Each  category  is  dis¬ 
cussed  separately. 

3.1.1  Changes  to  MAGIC.  This  category  is  divided  into  three 

subtopics: 

•  Additions. 

•  Modifications. 

•  Corrections. 

a)  Additions.  Of  primary  interest,  three  new  solids  have  been 
added: 


•  TEC  (Truncated  Elliptic  Cone). 

i)  Height  vector  does  not  need  to  be  perpendicular  to  the 
base  ellipse. 

ii)  Specify  (Table  3.1) 

-  V  -  vertex  of  base  ellipse, 

-  H  -  height  vector,, 

-  M  -  semimajor  axis  of  base  ellipse, 

-  m  -  semiminor  axis  of  base  ellipse,  and 

-  R  -  ratio  (base  ellipse/top  ellipse), 

viz. ,  R  *  (R1/R3)  =  (R2/R4) . 

(The  normal  height  vector  is  computed  in  GENI;  n  =  M  x  m;  it 
is  necessary  to  change  the  sign  of  n  if  H*n  <  0.) 


semimajor  axis 
semiminor  axis 


ORIGIN 

•  TOR  (Torus) 

Specify  (Table  3.1) 

-  V  -  vertex, 

-  n  -  normal  vector  (normal  to  the  plane  bisecting  the  torus), 

-  R1  -  radius  from  V  to  the  mid-point  of  the  torus'  cross 

section,  and 

-  R2  -  cross  sectional  radius  (R1  >_  R2) . 
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•  ARS  (Arbitrary  Surface) 

i)  Specify  M  curves  of  N  points  (see  Table  3.1). 

ii)  The  number  of  words  of  memory  is  92  +  M*N*4. 

iii)  An  ARS  can  be  described  in  more  than  one  way. 


A2,E2  A3,  E3 


D2  D3 


Example  (using  the  figure  above) . 


One  Approach  (Solid  Lines) 


Another Approach  (Dashed  Lines) 


M  -  5 


N  =  4 


M  =  4 


N  =  5 


curve  1  pt  Al,  A2,  A3,  A4 

curve  2  pt  Bl,  B2,  B3,  B4 

curve  3  pt  Cl,  C2,  C3,  C4 

curve  4  pt  Dl,  D2,  D3,  D4 

curve  5  pt  El,  E2,  E3,  E4 

Figure  closed  by  duplicate  curve 
Note:  pt  A1  =  Bl  =  Cl  =  Dl  =  El 

pt  A4  =  B4  =  C4  =  D4  =  E4 


curve  1  pt  Al,  Bl,  Cl,  Dl,  El 

curve  2  pt  A2,  B2,  C2,  D2,  E2 

curve  3  pt  A3,  B3,  C3,  D3,  E3 

curve  4  pt  A4,  B4,  C4,  D4,  E4 

Figure  closed  by  duplicate  points 
pt  A2  =  E2 
pt  A3  =  E3 


The  addition  of  these  new  solids  has  required  the  addition  of 
auxiliary  subroutines : 

•  QRTIC  to  solve  4th  degree  equation. 

•  CUBIC  to  aid  QRTIC. 


•  CROSS  to  compute  vector  cross  products. 

•  DOT  to  compute  dot  products. 

•  UNIT  to  compute  unit  vectors. 

•  ARIN  to  process  the  ARS  input. 

Additional  coding  is  also  similarly  required  in  subroutine 
CALC  to  compute  normals  and  in  GENI,  Gl,  and  WOWI. 

Quite  apart  from  the  new  solids,  coding  has  been  incorporated 
in  Geni  to  increase  input  checking  as  follows: 

•  Checks  of  vector  perpendicularity  in  BOX,  RAW,  REC,  and 
TEC. 

•  Checks  of  TRC  radii  to  ensure  that  Rg  / 

•  Checks  of  TOR  radii  to  ensure  that  R1  is  not  less  than  R_ 
(v.s.). 

Schematically,  an  option  has  been  added  to  suppress  tape  8 
(the  monitor  output)  output  (except  for  error  messages)  when  writing 
tape  1. 


Finally,  two  control  subroutines  have  been  created  to  assess 
quantities  other  than  line-of-sight  thickness: 

•  AREA  to  compute  presented  areas  (the  ray  is  traced  to  its 
first  contact) . 

•  MOMENT  to  compute  moments  of  inertia  (and  as  a  by-product, 
the  center  of  gravity,  total  weight,  total  volume,  mean 
angle  of  incidence,  and  the  mean  cosine  of  incidence  are 
also  computed) . 

b)  Modifications.  Seven  modifications  have  been  made: 

•  The  ELL  input  has  been  optimized. 

i)  Present  input  (cc  7-10  =  0  on  card  l)  is  both  foci  plus 
the  length  of  the  major  axis. 

ii)  Optimal  input  (cc  7-10  f  0  on  card  1)  requires  the 

vertex,  a  vector  representing  the  semimajor  axis,  and 
the  scalar  length  of  the  semiminor  axis. 

•  Computer  word  packing  has  been  converted  from  45  bits/word 
to  30  bits/word  (it  is  estimated  that  30  bit  packing  runs 
about  30  percent  faster  on  BRLSEC  I  and  II). 
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•  The  solid  input  section  has  been  revised  by  eliminating 
FLOCON  and  DIGCON  and  substituting  the  F-type  format 
specification. 

•  SENSESWITCH  settings  have  been  eliminated  and  their  control 
data  read  in  on  punch- cards. 

•  The  data  output  coding  in  TRACK  has  been  revised  to  elim¬ 
inate  SETUP  and  ISIGN  by  using  I  and  F-type  format 
specifications. 

•  A  version  of  MAGIC  has  been  written  in  "standard"  FORTRAN 
(incidentally,  this  version  runs  slower  on  the  BRLESCs  than 
any  of  the  versions  already  mentioned) . 

•  The  control  logic  in  the  main  program  has  been  modified  so 
that  VOLUM  can  be  run  without  reading  in  the  Identification 
Table. 

c)  Corrections .  Four  major  subroutines  were  found  to  have  more  or 
less  subtle  errors: 

•  VOLUM  faltered  when  G1  tried  to  combine  regions  of  the  same 
"item"  code  because  VOLUM  requires  that  each  region  be 
processed  separately;  a  special  exit  was  added  to  G1  to 
correct  this  condition. 

•  TESTG  suffered  a  similar  fate  but  to  a  greater  extent  since 
the  item  data  was  not  loaded  into  core  prior  to  the  execu¬ 
tion  of  TESTG;  an  additional  special  exit  was  added  to  G1 
to  rectify  this  condition. 

•  GEN I  computes  data  for  the  normal  vector  to  the  base  el¬ 
lipse  in  the  TEC  but  failed  to  ensure  that  the  normal  was 
an  inward  rather  than  an  outward  normal;  a  check  was  added 
so  that  if  H*n  is  negative  the  direction  of  n  is  reversed. 

•  CALC  was  unable  to  correctly  calculate  normal  thickness 
through  adjacent  regions  with  the  same  item  code  (cf. , 

VOLUM  and  TESTG);  a  modification  to  the  existing  exit  in 
G1  to  compare  the  item  code  of  the  next  region  with  the 
item  code  of  the  previous  region  was  made  to  allow  con¬ 
tinuing  the  normal  ray. 

3.1.2  Proposed  Plans  for  MAGIC.  Activity  in  four  areas  is 
being  carried  on: 

•  Compatibility  with  SAM-C  -  let  MAGIC  do  some  of  the  geom¬ 
etry  processing  for  SAM-C. 

•  Eliminate  part  or  all  computer  word  packing. 
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•  Couple  the  target  description  ray  tracing  directly  to  out¬ 
puts  such  as  vulnerable  area,  kill  probabilities,  etc. 

•  Addition  of  a  graphics  capability  via  plotters,  line- 
printers,  CRT  displays,  or  all  three. 

3.1.3  Concluding  Remarks.  The  actual  changes  required  to 
implement  the  three  new  solids  are  discussed  in  the  MAGI  report,  A 
Description  of  Three  Additional  Bodies  for  the  MAGIC  Conventional  Vul¬ 
nerability  Program,  by  J.  R.  Davis  and  M.  Moskowitz  (MAGI  report  MR  6902, 
May  1969).  An  abridged  version  of  this  report  consisting  of  the  main 
portion  of  the  text  appears  as  Appendix  B. 

In  any  direct  dealings  with  the  coding  of  the  MAGIC  program, 
a  knowledge  of  the  core  storage  layout,  input  data  requirements,  etc., 
is  essential.  Figures  3.1  through  3.4  supply  the  requisite  data: 

•  Figure  3.1  is  a  map  of  the  MASTER/ ASTER  array  showing  stor¬ 
age  for  the  processed  geometry  data.  Both  45-bit  and  30- 
bit  packing  versions  are  shown.  Variable  names  beginning 
with  L  are  the  locations  of  each  set  of  data  in  the  MASTER/ 
ASTER  array. 

•  Figure  3.2  concludes  the  map  of  the  MASTER/ ASTER  array 
showing  storage  of  the  identification  table  and  the  "working" 
storage  used  at  run  time. 

•  Figure  3.3  is  a  map  of  the  pointers  to  the  location  of  the 
solid  data. 

•  Figure  5.4  is  the  map  of  the  storage  for  the  arbitrary  sur¬ 
face  (ARS). 

Finally,  to  appreciate  the  relationships  between  various  rou¬ 
tines,  Figure  3.5  displays  the  many  auxiliary  routines  of  MAGIC  and 
their  relationship  to  the  main  of  "driver"  routines. 

3.1.4  Additional  Information.  In  October,  1969,  several  runs 
were  made  using  the  AMSAA  "Revised  Standard  MAGIC"  (Appendix  D)  on  a 
number  of  different  computing  systems.  The  geometry  input  cc.isisted  of 
a  description  which  we  shall  call  the  "December  '68  Master  Target." 

This  target  is  comprised  of  701  solids  and  904  regions;  none  of  the  three 
new  solids  were  used.  About  5  man-months  were  required  to  create  the 
description.  The  following  driver  routines  and  their  input  were  used: 


GRID 
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Storage  in  MASTER-a<^tfp  a 
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Figure  3.1  Partial  Map  of  the  MASTER-ASTER  Array 
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Figure  3.4  Storage  for  the  ARS 


Interrelationships  of  MAGIC  Routines 


Table  3.2  presents  the  results  of  the  various  computer  runs. 


TABLE  3.2  COMPUTER  SYSTEM  TIME  REQUIREMENTS 


System 

Location 

Time  {in  minutes) 

Ratio 

BRLESC  I 

ARDC ,  APG,  Md 

155 

1 

BRLESC  II 

ARUC,  APG,  Md 

55* 

.41 

CDC  6600 

* 

New  York  Umv 

15 

.11 

Using  the  on-line  printing  capability  instead  of  "dumping" 
onto  tape  for  off-line  tabulation. 


3.2  Recent  Activity  with  SAM-C  at  NEL.  (Presentation  by  Wayne 
Coleman) 

The  recent  activity  with  SAM-C  at  NEL  falls  into  one  of  three 
categories:  recent  calculations  completed  using  SAM-C,  completed  cor¬ 
rections  and  improvements  to  the  SAM-C  code,  and  plans  for  the  future. 

5.2.1  Recent  Calculations.  This  category  is  divided  into 
three  subtopics: 

•  Calculation  of  the  energy  dependent  gamma  flux  at  3  feet 
above  an  infinite  Co-60  "fallout"  field. 

•  Calculation  of  the  energy  dependent  and  total  neutron 
fluence  at  various  positions  within  the  Ralph  J.  Truex 
(Tandem  Van  dc  Graff)  accelerator  at  the  Nuclear  Effects 
Laboratory  (Edgewood  Arsenal). 

•  Calculation  of  the  energy  dependent  neutron  fluence  in  an 
environment  simulating  that  used  in  Operation  HENRE. 

a)  Infinite  Fallout.  Although  these  calculations  did  not  constitute 
a  comprehensive  test  of  the  geometric  capabilities  of  SAM-C,  very  good 
agreement  with  the  known  solution  of  this  problem  was  obtained. 

b)  Accelerator.  These  calculations  include  the  most  complex  geom¬ 
etries  that  have  been  simulated  to  date  at  NEL  and  were  included  for 
that  reason.  The  physical  results  unfortunately  cannot  be  compared  di¬ 
rectly  to  any  results  of  experiments  or  any  other  calculations. 
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c)  HEN RE.  This  problem  demonstrates  how,  under  certain  restric¬ 
tions,  ad  hoc  changes  can  be  made  to  produce  results  for  source  angular 
distributions  other  than  4ir-isotropic  or  monodirectional.  The  results 
compared  favorably  with  unfolded  flux  spectra  from  experimental  activa¬ 
tion  measurements  when  the  SAM-C  results  were  used  as  an  "input  guess 
spectrum"  in  the  unfolding  calculations. 

3.2.2  Corrections/ Improvements.  Corrections  are  indicated  by 
"C"  while  changes  that  are  more  in  the  category  of  improvements  are  in¬ 
dicated  by  "Cl."  C/CI’s  are  by  order  of  their  appearance  in  the  program. 

a)  Variable  Dimensioning  (Cl).  On  machines  that  assign  priority 
based  on  memory  requirements,  adjustable  sizes  of  blank  common  and 
labeled  common  CROSA  are  an  operational  necessity.  Variable  dimension¬ 
ing  in  SAM-C  is  accomplished  by  creating  an  artificial  "main"  program 
in  which  dimensioning  is  accomplished. 

b)  SEEK  (C).  Change  E  =  1  to  I  =  1  in  TUNC  and  MONTE. 

c)  SOUCAL  (C).  Set  "KKMAX  =  K-l"  between  FORTRAN  statement  num¬ 
bers  (S.N.)  780  ana  925. 

d)  CARLO  (C).  The  calculation  of  flux-at-a-point  following  an 
inelastic  collision  is  incorrect.  See  the  August  RSIC  Newsletter 
(No.  57)  for  details. 

e)  SOUP I C  (C/CI).  Volume  source  additions  may  be  made  by  modifying 
the  coding  shortly  after  FORTRAN  S.N.  800. 

f)  ARB  (C) .  T  was  inadvertently  used  as  a  variable  name  to  repre¬ 
sent  time  in  a  labeled  common  and  temporary  storage  in  the  routine 
(S.N.  50  and  50+1). 

g)  FAP  (Cl).  The  coding  for  identifying  point  fiux  contributions 
by  region  appears  here. 

h)  FAP  (C) .  To  correctly  calculate  flux-at-a-point  add  COMMON/ 
LSU/LSURF. 

i)  GIE  (C) .  (1)  The  scattering  problem  look-up  for  neutrons  was 

referencing  the  wrong  area  of  common  for  neutron  anisotropic  scattering; 
cf . ,  the  RSIC  version.  (2)  The  third  argument  in  the  call  to  SEEK 
(S.N.  185)  should  be  10  and  not  11.  (5)  Format  106  ends  incorrectly  - 

replace  "10"  with  any  desired  E-  or  F-type  format, 

j)  SUBED  (C).  Change  "NRMAX"  to  "NDET"  at  S.N.  121. 

k)  SOUCAL  (C).  Change  Format  402  (not  all  versions).  (Cl)  finally 
changes  to  compute  statistics  on  the  total  flux  or  fluence  for  flux-at- 
a-point  would  be  desirable. 
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3.2.3  Improvements  in  Progress.  Modifications  to  calculate 
flux  at  a  point  as  a  function  of  angle  or  direction  as  well  as  energy 
are  well  underway  at  NEL. 

3.2.4  Planned  Improvements.  Neutron  cross  section  represen¬ 
tation  is  earmarked  for  extensive  study.  Key  inputs  or  approaches  to 
this  subject  include  UNC-SAM-3,  an  ENDF/B  cross-section  processor,  and 

a  thorough  examination  of  the  representation  of  neutron  elastic,  angular 
scattering  distributions.  Total,  elastic,  and  non-elastic  cross  section 
data  are  also  expected  to  be  involved. 

3.3  Coordination  of  MAGIC  and  SAM-C. 

Both  MAGIC  and  SAM-C  process  card-image  target  description 
data  and  store  the  results  in  the  MASTER/ASTER  array.  Both  can  compute 
volumes.  If  the  conventional  component/space  code  table  has  been  cre¬ 
ated,  a  trivial  program  (Program  COMPAS)  exists  to  convert  this  data 
to  a  region/chemical  composition  assignment  table.  The  following  two 
sections  describe  the  changes  required  so  that  target  descriptions  can 
be  utilized  by  either  MAGIC  or  SAM  on  a  wide  variety  of  computational 
equipment  with  a  minimum  of  difficulty.  The  goal,  of  course,  is  to  per¬ 
mit  the  creation  of  a  library  of  target  descriptions  which  can  serve 
two  purposes:  they  can  reduce  duplication  of  effort  and  they  can  lend 
insight  into  what  a  given  agency  considers  an  adequate  degree  of  descrip¬ 
tive  detail. 


3.3.1  Discussion.  This  category  is  divided  into  two  subtopics 
a  description  of  the  proposed  tape's  contents  and  a  discussion  of  how  the 
tape  should  be  created. 

a)  Description  of  the  Tape  Contents.  The  first  step  is  to  identify 
the  data  available  for  the  library  tape;  these  data  are  displayed  in 
Table  3.3. 


TABLE  3.3  TARGET  DESCRIPTION  DATA  AVAILABLE 


MAGIC 

SAM-C 

"Processed"  (GENI)  Target 

Output  Data  (MASTER- ASTER*) 

Region  Identification  Table 

Composition  Assignment  Table 

Volumes  (Optional) 

Chemical  Composition  Definitions 

Region  Weights  (Optional) 

"Processed"  (BAND/BEDIT)  Cross 
Section  Data  (MASTER-ASTER) 

Moment  of  Inertia  (Optional) 

Volumes  (ASTER) 

Target  Description  Title 

"Raw"  (Card- Image)  Target  Description  Solid  §  Region  Data 

*The  SAM-C  program  stores  these  data  in  a  location  different  from  that 
used  by  MAGIC. 
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TABLE  3.4  LIBRARY  TAPE  CONTENTS:  PARTS  1  AND  2 


"Block"  1.  Identification  (80A1) 

Target  Description  Title 

"Block"  2.  Table  of  Contents 

(1)  Solid/Region  Table  Format  (cc  1-5) 

0  :  GENI  Input  form 

i  0  :  GENI  Output  form 

For  (2)  through  (8),  0  means  the  category  was  not  included  while  a  non¬ 
zero  entry  indicates  that  the  data  was  included 

(2)  Region  Identification  Table  (cc  6  -  10) 

(3)  Composition  Assignment  Table  (cc  11  -  15) 

(4)  Volumes  (cc  16  -  20) 

(5)  Chemical  Composition  Data  (cc  21  -  25) 

(6)  Region  Total  Weights  (cc  26  -  30) 

(7)  "Organized"  Cross-Section  Data  (cc  31  -  35) 

(8)  Moment  of  Inertia  Data  (cc  36  -  40) 

(9)  -(10)  (Spares)  (cc  41  -  50) 

cc  51-52  Unit  Systems  (Examples:  IP  for  inches,  pounds  (8  seconds), 
CG  for  centimeters,  grams,  seconds,  etc.) 

cc  53  Coordinate  System  "Handedness"  L  =  left,  R  =  right 

cc  54-80  Location  of  Geometric  Origin  with  respect  to  the  Reference 

Origin  (e.g.,  for  "tanks"  the  reference  origin  is  frequently 
the  intersection  of  the  turret  datum  line  and  the  vehicle 
centerline)  (3E9.2) 
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The  second  step  is  to  determine  the  data  to  be  loaded  and 
in  what  order.  Clearly,  the  target  description  title  plus  some  type  of 
flagging  to  indicate  the  data  categories  available  should  appear  near  the 
start  of  the  tape  to  minimize  the  time  spent  in  identifying  the  tape 
contents.  It  is  therefore  proposed  that  the  first  tape  "block"  consist 
of  ten  flag  words  as  described  in  Table  3.4.  Beyond  these  two  points, 
any  data  that  describe  the  target  are  suitable  for  inclusion  on  the  tape. 

b)  Approach.  It  was  the  consensus  of  the  program  users  that,  while 
all  library  tapes  should  be  in  BCD  format  for  transmittal,  the  basic  tar¬ 
get  description  solid  and  region  data  should  be  in  card-image  rather  than 
in  "processed"  (GENI  output)  form;  except  for  a  few  installations,  the 
computer  time  spent  in  reprocessing  the  "raw"  data  is  negligible  com¬ 
pared  with  the  time  that  would  be  used  to  convert  the  data  into  the  form 
required  by  those  of  a  different  installation.  It  was  also  agreed  that 
the  raw  data  approach  would  place  the  least  number  of  restrictions  on 
the  internal  operating  procedures  of  any  given  MAGIC  or  SAM-C  program 
user. 


3.3.2  Program  Changes.  Some  coding  changes  of  a  very  minor 
nature  will  be  required.  The  routines  affected  are: 

a)  MAGIC.  The  main  program  plus  GENI,  VOLUM,  the  moment  of  in¬ 
ertia,  and  the  vulnerable  area  routines  will  require  modification. 

b)  SAM-C.  TUNC,  GENI,  DR,  and  VOLUM  are  involved.  In  SAM-C, 
VOLUM  will  generally  only  require  an  additional  output  statement. 


4.  DEFINITION  OF  MAGIC  AND  SAM-C;  CREATION  OF  SOURCE  DECKS 

This  provided  the  first  opportunity  of  the  conference  for  the 
conferees  to  determine  the  course  of  action  to  be  followed.  The  two 
sections  that  follow  present  the  consensus  achieved  by  the  conferees  in 
defining  what  the  capabilities  of  the  two  programs  should  be  and  in 
determining  how  these  capabilities  should  be  achieved. 

4.1  MAGIC. 

The  following  sections  represent  the  major  areas  discussed  at 
the  conference  together  with  the  results  of  these  discussions. 

4.1.1  Standard  Version.  A  consensus  was  achieved  in  four 

areas : 

a)  Input.  The  input  to  MAGIC  will  consist  of 

•  RPP  Data, 

•  Solid  Description  Data,  and 

•  Region  Description  Data. 
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b)  Subprograms .  The  subprograms  are  characterized  as  "geometry 
processing"  (including  some  testing) : 

•  GENI, 

e  ALBERT, 

•  RPPIN,  and 

•  ARIN, 

or  "ray  tracking"  (but  not  in  the  sense  of  GRID  which  is  considered  a 
"driver  routine") : 

•  Gl, 

•  W0WI/RPP2, 

•  RPP/body  routines  +  TOR,  ARS  §  TEC,  and 

•  Auxiliary  body  routines  such  as  QRTIC,  UNIT,  etc. 

c)  Program  Features. 

•  No  packing. 

•  It  should  be  possible  to  use  an  RPP  to  subdivide  the  target, 
itself. 

•  Drop  TESTG. 

•  Drop  FLOCON  and  DIGCON. 

•  Output  the  processed  geometry  which  should  consist  of  titling 
data,  the  geometry  data,  and  the  functional  identification 
table. 

d)  Tests.  It  was  agreed  that  TESTG  as  a  random  but  supposedly 
complete  test  of  the  description  is  inefficient  and  should  be  dropped; 
in  its  place,  a  driver  routine  of  interest  -  such  as  GRID  -  should  be 
used.  Input  testing  was  considered  valid  and  at  least  the  following 
tests  should  be  available: 

•  Legitimacy  of  solid  names. 

•  Vector  perpendicularity  for  boxes,  RAlV’s,  and  the  REC. 

•  Equal  radii  in  the  TRC. 

•  Region  checking  (on  an  optional  basis). 

•  "4-points-in-a-plane"  in  the  ARB. 

•  Degenerate  plane  in  the  ARB. 
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»  Proper  ordering  of  RPP  input. 

®  Proper  structure  creation  by  contiguous  RPP's  (since  the 
structure  that  would  enclose  all  RPP's  must  be  in  the  shape 
of  an  RPP) . 

4.1.2  Ad  Hoc  Problems.  Although  there  was  not  enough  time 
for  the  formal  formation  of  working  groups  to  solve  ad  hoc  problems, 
the  following  problems  were  defined  for  solution  by  any  interested  groups 
or  individuals. 

•  The  creation  of  a  technique  for  the  arbitrary  designation 
of  solids  to  have  the  special  characteristics  currently 
displayed  by  the  RPP. 

•  The  identification  of  methodological  differences  in  the 
routines  that  form  MAGIC  between  versions  held  by  the  sev¬ 
eral  agencies  using  MAGIC. 

•  The  establishment  of  a  methodology  for  creating  "library" 
routines  (for  such  configurations  as  wheels,  people,  etc.) 
which  can  be  processed  as  a  unit  rather  than  a  set  of 
distinct  subsolids. 

•  The  establishment  of  a  uniform  system  of  flags  for  trans¬ 
mittal  of  the  processed  geometry. 

4.2  SAM-C. 

SAM-C  was  not  the  subject  of  serious  discussion  until  late  in 
the  afternoon  of  the  second  day.  Because  the  SAM-C  program  is  so  large 
and  complex,  our  attitude  toward  it  is  considerably  different  than  our 
attitude  toward  MAGIC.  In  the  first  place  (and  of  overriding  impor¬ 
tance)  ,  there  are  few  computing  facilities  capable  of  efficiently 
executing  the  SAM-C  programs;  secondly,  a  substantial  amount  of  under¬ 
standing  of  the  code  and  the  manner  in  which  it  attempts  to  solve  prob¬ 
lems,  and  of  the  problems  themselves,  is  required  to  achieve  any  sort 
of  successful  solution.  Keeping  these  points  in  mind,  the  following 
sections  present  the  consensus  reached. 

4.2.1  Standard  Version.  For  the  time  being  at  least,  the 
standard  version  of  SAM-C  will  be  that  obtainable  from  RSIC  at  Oak  Ridge. 
In  brief,  this  version  features  Combinatorial  Geometry  inputs  identical 
to  those  of  Standard  MAGIC  with  one  important  difference:  triplet  and 
scalar  inputs  will  be  allowed. 

4.2.2  Ad  Hoc  Problems.  Although  time  was  again  insufficient, 
the  following  study/problem  areas  were  defined: 

•  The  abolishment  of  computer  word  packing  to  the  greatest 
practical  extent. 
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•  The  incorporation  of  ENDF/B  cross  sections  -  preferably 
using  a  noncommon  energy  mesh. 

•  Bonafide  time  dependence:  time  dependence  currently  assumes 
the  source  is  a  separable  function  of  time. 

•  Simplification  of  input  preparation. 


S.  CREATION  OF  BENCHMARK  PROBLEMS 

Although  time  constraints  precluded  the  actual  creation  of  test 
problem  input,  it  was  possible  to  indicate  what  the  benchmark  problems 
should  include. 

5.1  MAGIC. 

The  test  problem  input  should  meet  five  conditions: 

•  Use  only  the  solids  generally  available;  place  the  three 
new  solids  at  the  end  of  the  solid  table  for  possible 
deletion. 

•  Use  all  three  region  operator  symbols  (+,  OR). 

•  Use  1  RPP  to  enclose  the  target  (Wright-Patterson  AFB  will 
use  a  BOX). 

•  Employ  solids  in  such  a  way  that  they  present  overlaps  and 
contiguities. 

•  Similarly,  ensure  that  at  least  one  situation  arises  where 
more  than  one  following  region  has  the  same  functional 
identification  code  as  the  region  in  front  (to  ensure  that 
the  correct  normal  thickness  is  being  computed) . 

In  addition,  it  is  desirable  to  introduce  a  few  deliberate  errors  to 
ensure  that  internal  error  checks  are  operative. 


5.2  SAM-C. 


It  was  decided  that  more  than  one  benchmark  problem  should  be 
created  to  enable  checking  the  modeling  of  the  physical  solution  and 
the  execution  of  the  code.  Two  benchmark  problems  were  agreed  upon: 

•  The  "infinite"  faliout  problem  (RSIC  Benchmark  Problem 
No.  4),  and 

•  AFWL  "Rocket"  Geometry. 

Physical/code  input  for  these  problems  is  presented  in  Appendix  C. 
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API’BND iX  A.  MAGIC/SAM-C  CONFERENCE  PARTICIPANTS 


Name 

Agency 

1. 

Robert  E.  Bamas 

Picatinny  Arsenal 

2. 

Sue  Gibson 

AFATL 

3. 

Carry  Bain 

AMSAA  (Methodology) 

4. 

Matthew  J.  Rei singer 

BRL  (VL) 

5. 

John  A.  Zook 

AMSAA  (ASA) 

6. 

Thomas  Jankunis 

Picatinny  Arsenal 

7. 

Jesse  W.  Brewer 

AMSAA  (ASA) 

0 
yj  • 

Donald  W.  Mowrer 

BRL  (VL) 

9. 

Robert  fi.  Walther 

BRL  (VL) 

10. 

Lewis  G.  Gotze 

BRL  (VL) 

11. 

John  Saarmann 

Picatinny  Arsenal 

12. 

Michael  J.  Paul 

AFWL  (WLRAS) 

13. 

A.  Kris  Widdison 

AFWL  (WLDC-PD) 

14. 

Kenneth  Richer 

BRI.  (S§PL)  • 

IS. 

George  H.  Connor,  Jr. 

BRL  (NEL) 

16. 

Robert  IV.  Rous  sin 

ORNL  -  RSIC 

17. 

IVayne  A.  Coleman 

BRL  (NEL) 

18. 

IV.  B.  Beverly 

BRL  (NEL) 

19. 

Janet  Lacetera 

BRL  (NEL) 

20. 

Richard  Saum 

BRL  (NEL) 

21. 

William  Ralph 

NWL 

22. 

Robert  E.  Gray 

NWL 

23. 

Roy  R.  Hilbrand 

ASD  ! 

24. 

Gerald  Bennett 

ASD 

25. 

Robert  Kesselman 

Picatinny  Arsenal 

26. 

Joe  Burgio 

Picatinny  Arsenal 

77, 

Norman  S.  Banks 

BRL  (TBL) 

28. 

Robert  Lake 

AMSAA  (ASA)  '  ' 

29. 

Ronald  Marking 

AMSAA  (ASA) 

City,  State 

Dover,  New  Jersey 
, Eglin  AFB,  Florida 
APG,  Md. 

APG,  Md. 

APG,  Md. 

Dover,  New  Jersey 
APG,  Md. 

APG,  Md. 

APG,  Md. 

APG,  Md. 

Dover ,  New  Jersey 
Albuquerque,  N.  M. 
Albuquerque,  N.  M. 
APG,  Md. 

Edgewood  Arsenal,  Md. 
Oak  Ridge,  Tennessee 
Edgewood  Arsenal,'  Md. 

i 

Edgewood  Arsenal,  Md. 

Edgewood  Arsenal,  Md-. 

Edgewood  Arsenal.  Md. 

Dahlgren,  Virginia 

Dahlgren,  Virginia 

Dayton,  Ohio 

Wright-Patterson  AFB, 
Ohio  ' 

Dover,  New  Jersey 

Dover,  New  Jersey 

APG,  Md. 

APG,  Md. 

APG,  Md. 
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B.l  ORGANIZATION  OF  THE  NEW  MAGIC  PROGRAM 


The  general  organization  of  the  MAGIC  program  remains  as 
before.  The  following  subroutines  were  changed:  CALC,  GENI,  GI,  WOWI. 
The  following  routines  were  added:  TEC,  TOR,  ARS,  DOT,  CROSS,  UNIT, 
QRTIC,  CUBIC,  ARIN.  A  description  of  the  changes  to  existing  subroutines 
and  the  new  subroutines  follows: 

B.1.1  Changes  to  CALC. 

CALC  -  Statement  18  -  Change  the  computed  "go  to"  by  adding 
locations  for  computing  the  normals  in  the  new  bodies. 

Statement  500 
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The  equation  for  the  ellipse_parallel  to  the  base  ellipse 
and  through  the  point  of  intersection  X  is 


(2) 

(3) 

(4) 


((X-V-yH)  -A*)2  ((X-V-vH)  »K*)2  _  . 

2  2 
Tm  m 

y  =  ML*  ,  and 
H-n 

m  =  yr4  +  (l-y)r2  * 


NOTE:  Y  and  t  and  X  are  known. 

Expanding  we  get 


Differentiating,  with  respect  to  X,  Y,  and  Z,  and  taking  the 
unit  vector  of  the  result  gives  us  Equation  (1). 

Statement  550 


The  section  computes  the  normal  to  the  torus  at  the  point  of 
intersection.  The  equation  used  is: 


(1) 


X  -  (C+r^*) 


WB  = 


where  X  is  point  of  intersection, 

C  is  center  of  torus, 

r^  is  distance  from  center  to  the  locus  of  mid-point  of 
circular  cross  section 

d*  =  unit  {d} , 

d  =  {rfX(X-c)}  X  n"  =  direction  of  ^  in  plane,  and 
r2  is  radius  of  circular  cross  section. 


48 


Statement  575 


This  coding  examines  the  intersection  with  the  arbitrary  sur¬ 
face  (XI) ,  selects  the  proper  normal  from  those  left  in  the  MASTER/ ASTER 
array  by  ARS,  and  places  this  normal  into  WB.  See  write-up  of  ARS 
routine  to  determine  details  of  computation. 

B.1.2  Changes  to  GENI. 

GENI  -  Change  all  computed  GO  TO*s  involving  body  type  to  add 
three  new  bodies.  Add  conversion  routines  to  store  TORUS  and  Elliptic 
Cone  data  in  either  floating  point  or  triplet  and  scalar  form.  Add 
coding  to  store  Arbitrary  Surface  in  floating  point  format.  (Subroutine 
ARIN) . 


B.1.3  Changes  to  Gl. 

G1  -  For  a  new  ray,  processing  remains  the  same,  except  for 
changing  the  computed  GO  TO  to  check  the  new  bodies.  For  continuation 
of  a  ray,  a  check  is  made  for  TORUS  or  ARBITRARY  SURFACE.  If  the  body 
is  neither  of  these,  the  previously  computed  value  is  used.  However, 
if  the  body  type  is  one  of  these  a  check  is  made  to  see  if  the  distance 
we  have  traveled  is  greater  than  ROUT.  If  it  is  not  then  we  use  the 
existing  values  for  RIN  and  ROUT.  Otherwise,  we  reenter  the  body  rou¬ 
tine  and  compute  the  next  RIN/ROUT  set.  (if  any) . 

B.1.4  Changes  to  WOWI. 

WOWI  -  The  same  changes  as  were  made  to  Gl  apply  here.  A 
description  of  the  new  routines  follow. 

B.1.5  Addition  of  TEC. 

TEC  -  Body  routine  for  truncated  elliptic  cone.  Computes  RIN, 
ROUT,  LRI,  LRO  for  intersection  of  ray  and  cone.  Uses  DOT,  CROSS,  and 
SQRT. 

B.1.6  Addition  of  TOR. 

TOR  -  Body  routine  for  torus .  Computes  RIN  and  ROUT ;  LRI  and 
LRO  are  1.  If  four  roots  are  found  it  selects  the  first  pair 
greater  than  DIST  as  RIN  and  ROUT.  Uses  QRTIC  and  CUBIC. 

B.1.7  Addition  of  QRTIC. 

QRTIC  (A,B,C)  -  Solves  quartic  polynomial  equation  with  unit 
leading  coefficient,  X4  +  C^X5  +  C^X2  +  C^X  +  C^  =  0. 
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Method  is  from  J.  V.  Uspensky,  "Theory  of  Equations/' 
pp  94-95.  Used  by  TOR. 

A  =  Array  of  coefficients 

B  =  Array  of  roots 

C  =  Number  of  real  roots 

B. i. 8  Addition  of  CUBIC. 

CUBIC  (A,B,C)  -  Solves  cubic  polynomial  equation  with  unit 
3  2 

leading  coefficient,  X  +  C^X  +  C2X  +  C^  =  0. 

Method  is  from  J.  V.  Uspensky,  "Theoiy  of  Equations," 
pp  84-93.  Used  by  TOR. 

A  =  Array  of  coefficients 

B  =  Array  of  roots 

C  =  Number  of  real  roots 

B.i.9  Addition  of  DOT. 

DOT  (A,B)  -  Computes  the  dot  product  of  vectors  A  and  B. 

B.1.10  Addition  of  CROSS. 

CROSS  (A,B,C)  -  Computes  the  cross  product  of  vectors  B  and 
C  and  stores  result  in  vector  A. 

B.1.11  Addition  of  UNIT. 

UNIT  (A)  -  Computes  unit  vector  of  A  and  stores  back  in  A. 
B.1.12  Addition  of  ARS. 

ARS  -  Body  routine  for  arbitrary  surface.  Computes  RIN,  ROUT. 
LRI  and  LRO  are  always  1. 

For  the  purposes  of  determining  intersections  and  normals,  the 
routine  constructs  a  series  of  triangles,  as  below,  and  utilizes  these 
triangles  to  determine  intersections  and  the  associated  normals. 
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When  entered  for  a  new  ray,  the  intersections  are  stored  in  the  MASTER/ 
ASTER  array,  together  with  the  normals  at  these  points.  Upon  reentry 
for  the  same  ray,  the  RIN,  ROUT  pair  appropriate  to  DIST  are  selected 
and  returned  to  the  calling  routine. 

To  determine  the  intersection  and  normals,  the  ray  is  tested 
against  each  triangle  for  which  at  least  one  point  of  the  triangle  lies 
within  the  projection  of  the  grid  square.  The  calculation  is  done  as 
follows : 


By  the  rules  of  convex  figures  in  2-space,  for  x  within  the 
triangle,  there  must  exist  a,3,y  such  that 


CD 


au+Bv+YW=x=x^+  swfe 


a  +  3  +  Y  =  1;  «,B,y  >  0  ; 


then 

Y  -  1  -  a  -  3  , 

(2)  .  au  +  3v  +  (l-a-g)w  =  x^  +  sw^  ,  and 

(3)  a(u-w)  +  3(v-w)  -swb  =  x^-w  . 

These  are  simply  three  equations  in  three  unknowns. 

Using  determinants  to  solve  this  set  of  simultaneous  equations 
we  obtain  a,3,Y»  and  s.  After  verifying  that  a  +  3  +  y  =  1  and 
a,3,y  >  0,  we  record  the  s  value  as  well  as  a  unit  normal  to  the  tri¬ 
angle.  If  a,3,y  fail  to  meet  these  requirements,  the  ray  missed  this 
triangle. 
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After  performing  the  calculations  for  each  triangle,  the  re¬ 
sulting  s  values  and  normals  are  placed  in  the  MASTER/ASTER  array.  Suf¬ 
ficient  space  is  provided  for  up  to  ten  pairs  of  RIN  and  ROUT.  The 
variable  DIST  is  used  to  determine  which  pair  of  RIN  and  ROUT  should  be 
returned  to  the  calling  routine. 


B.2  DESCRIPTION  OF  INPUT  PARAMETERS 
B.2.1  Truncated  Elliptic  Cone. 

Specify  a  vertex  V  at  the  center  of  the  larger  ellipse,  the 
height  vector  H,  expressed  in  terms  of  its  x,y,z  components,  the  direc¬ 
tion  of  the  major  axis  A,  the  direction  of  the  normal  N,  and  three 
scalars  -  Rl,  the  length  of  the  major  axis  of  the  larger  ellipse,  R2, 
the  length  of  the  minor  axis  of  the  larger  ellipse,  and  P,  the  ratio 
of  the  larger  to  the  smaller  ellipse. 

B.2. 2  Torus. 

Specify  a  vertex  V.  at  the  center  of  the  torus,  the  normal  to 
the  plane  in  which  the  locus  of  mid-points  of  the  circular  cross  sections 
lie,  N,  and  two  scalars  -  Rl,  the  distance  from  the  center  to  the  mid¬ 
point  of  circular  cross  section,  and  R2,  the  radius  of  circular  cross 
section. 


B.2. 3  Arbitrary  Surface. 

Specify  the  number  of  curves  (M)  to  be  specified  and  the  num¬ 
ber  of  points  (N)  which  will  be  specified  on  each  curve.  A  surface  is 
constructed  between  curve  1  and  curve  2,  between  curve  2  and  curve  3, 
etc.  The  user  must  be  careful  that  the  described  figure  is  closed  and 
solid. 


CURVE  1  &  5 
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If 


In  the  previous  example,  the  first  and  last  point  of  each  curve 
is  identical,  and  the  first  curve  is  identical  to  the  last,  and  one  can 
see  that  the  figure  is  solid. 


CURVE  1 


CURVE  3 


CURVE  4 


In  this  example,  curve  1  consists  of  the  same  point  repeated 
five  times,  curve  2  of  five  points  (the  first  and  fifth  point  being  the 
same),  curve  3  is  defined  similar  to  curve  2,  and  curve  4  similar  to 
curve  1.  It  can  also  be  seen  that  this  figure  is  solid. 

To  further  illustrate  this  figure,  note  in  the  figure  that 

M  =  4  N  =  5 

Curve  1  pt.  Aj 

B, 


Curve  2 


pt. 
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M  =  4 


N  =  5 


Curve  3 


Curve  4 


is  identically  the  same  figure  as 
M  =  5 


pt. 


pt. 


N  =  4 


Curve  1 


Curve  2 


Curve  3 


pt. 


rtl 

*2 

A„ 


4 

pt.  Bx 
B- 


pt. 
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M  =  5 


N  =  4 


Curve  4 


Curve  5 


«t. 


pt. 


D 

D 

D 

D 

E 


1 

2 

3 

4 
1 


E 


2 


£ 


3 


E 


4 


The  user  should  use  this  isomorphism  as  a  check  on  whether 
the  figure  defined  is  truly  closed  and  solid. 


B. 3  BODY  CARDS 

The  data  describing  each  body  must  be  input  using  the  format 
described  in  Table  B.l.  This  table  is  similar  to  Table  3.1  (page  37 
in  the  original  document)  and  should  be  viewed  as  an  extension  of  that 
table. 


B.4  NEW  VARIABLES  IN  COMMON 


Variable 

Labeled 

Name 

Common 

Definition 

IGRID 

DAVIS 

• 

The  grid  square  of  the  origin  of 
the  current  ray  (XBS) 

LOOP 

DAVIS 

Set  by  G1  upon  entry  to  a  body 
routine  to  reflect  ray  number  of 
last  ray  fired  at  the  body. 

INORM 

DAVIS 

Set  by  G1  to  indicate  if  the  ray  is 
being  fired  normal  to  a  surface 

(normal  is  computed  by  CALC) 
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I 


I 


B. 5  NEW  ERROR  STOPS 


Routine 

Message 

Explanation 

CALC 

ARS  DID  NOT 

FIND  NORMAL 

Data  in  MASTER/ ASTER'  Array  incon¬ 
sistent.  Some  routine  has  destroyed 
portions  of  MASTER/ ASTER. 

S6 


TABLE  B. 1 


APPENDIX  C 

SAM-C  BENCHMARK  PROBLEM  INPUT 
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"1.  INTRODUCTION 


The  dose  rate  three  feet  above  an  air/ground  interface  con¬ 
taminated  with  gamma-ray  emitting  isotopes  is  often  used  as  a  basic 
normalizing  parameter  in  fallout  radiation  environment  studies  and  fall¬ 
out  shielding  methodology.  For  example,  the  dose  rate  three  feet  above 
a  fallout  field  is  the  basic  quantity  to  which  geometric  and  barrier 
factors  are  applied  in  the  currently-used  "Engineering  Method" 
(References  1,2*).  This  technique  predicts  shield  effectiveness  in 
fallout  situations.  There  have  been  experimental  measurements  of  the 
dose  above  fallout  fields  in  several  weapons  test  (References  3,4)  and 
several  calculations  (References  1,5)  of  the  same  quantity  have  been 
made. 


"However,  because  of  the  obvious  difficulties  associated  with 
measurements  of  actual  fallout,  many  studies  have  concerned  themselves 
with  the  radiation  environment  above  interface  planes  contaminated  with 

a  single  isotope.  In  particular,  137Cs  and  ^°Co  have  been  extensively 
used  in  these  investigations. 


"2.  THE  AIR/GROUND  INTERFACE  PROBLEM 


This  benchmark  problem  is  concerned  with  the  theoretical  com¬ 
putation  of  various  quantities  above  an  ideal  air/ground  interface  uni¬ 
formly  contaminated  with  60Co.  A  discussion  of  experimental  results  is 
also  included  for  comparative  purposes. 

"2.1  Problem  Geometry 


Figure  Cl  illustrates  the  geometry  for  the  theoretical  bench¬ 
mark.  A  receiver  (detector)  point  is  located  three  feet  above  the  air/ 
ground  interface  which  is  assumed  to  be  smooth  and  infinite  in  extent. 

^Co  is  uniformly  distributed  on  the  interface.  Although  ^Co  emits 
one  1.17  MeV  photon  and  one  1.33  MeV  photon  per  disintegration,  many 
studies  assume  an  average  photon  energy  cf  1.25  MeV.  This  assumption 
introduces  negligible  errors,  and  the  benchmark  data  are  normalized  to 
a  source  strength  of  one  1.25  MeV  photon  emitted  isotropically  per 
2 

cm  of  interface  area  per  second.  [For  SAM  C  the  photon  energy  of  1.33 
MeV  was  used.] 


* 

References  are  not  included  in  this  abridged  version.  Ed. 
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BASED  ON  ORNL-DWG  69-2121  IN  SHIELDING  BENCHMARK  PROBLEM  4.0. 
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"Table  I  lists  the  constituents  of  the  air  and  ground.  The 

_  *7  *7 

air  density  is  1.29  x  10  g/cm  ;  the  ground  is  assumed  to  have  a  compo¬ 
sition  similar  to  Nevada  Test  Site  soil  (Reference  6). 


TABLE  I  AIR  AND  GROUND  COMPOSITIONS 


Element 


Atomic  Concentration  (atoms/cm  j 


Air 


Ground 


Nitrogen 

Oxygen 

Argon 

Hydrogen 

Oxygen 

Aluminum 

Silicon 


4.19  x  10 


19 


1.13  x  10 


19 


2.53  x  10 


17 


8.55  x  10 


21 


2.27  x  10 


22 


2.01  x  10 


21 


9.53  x  10 


21 


There  has  been  a  slight  change  in  format.  Ed. 


"2.2  Quantities  Calculated 

Quantities  calculated  at  the  receiver  point  are:  (1)  the 
total  kerma  rate,**  T,  in  air;  (2)  the  kerma  rate,**  D,  in  air  from 
uncollided  photons;  (3)  the  dose  buildup  factor,  B;  and  (4)  the  differ¬ 
ential  angle  and  energy  distribution  of  the  number  flux  density,  4>(E,0), 
where  8  is  the  receiver  polar  angle  (Figure  Cl).  The  number  flux 
density  energy  spectrum,  1(E),  [is  the  only  quantity  calculated  by  SAM  C] 
...."[calculated  results  appear  in  Tabular  Form  in  Table  IV  and  in 
graphical  form  in  Figure  C2] . 


** 

For  the  photon  energies  and  geometry  of  this  problem,  the  numerical 
difference  between  kerma  rate  and  absorbed  dose  rate  in  air  is  small 
and  can  be  ignored.  Other  studies  quote  kerma  rate  in  tissue,  and 
adjustments  should  be  made  to  compare  the  results  of  such  studies  with 
this  benchmark. 
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* 

TABLE  IV  SCATTERED  PHOTON  KERMA  RATES  THREE  FEET  ABOVE  AN  INFINITE 
60Co  CONTAMINATED  PLANE 


Energy  Interval 
(MeV) 

K(E) 

(ergs=cm2/ g) 

Flux  Density 
(Photons/ cm2-s  ec) 

Kerma  Rate 
(ergs/g-sec) 

.02  - 

.03 

1 . 06 (-8) 

1.47 (-3) 

1.56(-11) 

.03  - 

.04 

5. 28 (-9) 

1.55  (-2) 

8. 18 (- 11) 

.04  - 

.06 

3.06(~9) 

9. 32  (-2) 

2.85(-10) 

.06  - 

.10 

3 . 06  (-9) 

2.10  (-1) 

6.43(-10) 

.10  - 

.18 

5. 56 (-9) 

2 . 99  (-1) 

1 . 66  (-  9) 

.18  - 

.30 

1.08 (—8) 

2.94 (-1) 

3. 18(-  9) 

.30  - 

.50 

1.89 (-8) 

1.93(-1) 

3.65(-  9) 

.50  - 

.75 

2.92 (-8) 

1.08(-1) 

3. 15  (-  9) 

.75  - 

1.00 

3.97  (-8) 

8. 31(-2) 

3.30(-  9) 

1.00  - 

1.25 

5.00 (-8) 

1.69(-1) 

8.45(-  9) 

TOTALS: 

1.47(0) 

r — V 

00 

1 

' — / 

• 

CM 

NOTE:  Read  1.06(-8)  as  1.06  x  10 

* 

Tables  II  and  III  have  been  omitted  in  this  version.  Ed. 


[Results] 


"On  Figure  C2  (Figure  6  in  original  document),  differential 
scattered  photon  flux  density  energy  spectra  are  plotted  for  the  two  cases 
shown  on  Figure  4,*  along  with  data  from  a  7,000  history  air/ground  COHORT 
Monte  Carlo  study  by  French  (Reference  21).  Although  neither  the  Table 
III  or  the  COHORT  data  was  smoothed  in  any  way  prior  to  constructing 
Figure  5,  adjustments  had  to  be  made  in  the  three  lowest  energy  groups  of 
the  air/compressed  air  case.  In  that  case,  a  severe  fluctuation  (visible 
on  Figure  4)  occurred  in  the  30°  -  40°  angle  interval  in  each  of  the  three 
energy  bins.  The  solid  curve  on  Figure  5  was  obtained  by  intuitively 
smoothing  all  available  data  and,  in  addition,  making  use  of  two  known 
facts;  the  magnitude  of  the  discontinuity  at  the  first  scattering  cutoff 
energy  (0.212  MeV)  and  the  value  at  the  source  energy  (1.25  MeV).  As 
described  in  Reference  24,  these  values  can  be  easily  and  accurately 
computed.  The  value  computed  for  the  energy  spectrum  at  1.25  MeV  is  0.43 
photons/cm2-sec-MeV,  and  the  magnitude  of  the  discontinuity  is  3.40 
photons/cm2-sec-MeV. 


*Figures  2,  3,  4,  and  5  of  original  document  have  been  omitted.  Ed. 
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Figure  C2  Monte  Carlo  Scattered  Flux  Density  Energy  Spectra. 


"In  conclusion,  it  is  to  be  emphasized  that  the  differential 
data  and  smoothed  curves  presented  on  Figures  3,  4,  and  5  contain  rather 
large  uncertainties,  and  must  not  be  taken  as  absolute  standards...." 
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C.2  AIR  FORCE  WEAPON  LAB  "ROCKET"  GEOMETRY 
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SAM-C  GEOMETRY  (CONT. ) 
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LISTING  OP  THE  AMSAA  OCTOBER  REVISED  STANDARD  MAGIC  PROGRAM 
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DIMENSION  MASTER  (30000)  ,A'(6J 
COMMON  ASTER!  300 GO) 

COMMON/GEOM/LBAS£,RTN,KOUT,LRI ,LRO,PINF,  IERk.DIST 
LUMMr'N/UNCGEM/.\,RPP  ,NTR  1  P  ,  NS  CAL  »N80DY , NRMAX»L  TR I P  »LSCAL , LREGD , 

1  LUA!A, LRIN,LKO  T ,LIO,LOCUA, 115, 130, IBODY.NASC.KLOOP 
COMMON/  I EMPOR/XS  ( 6  ) »  X  ( 6 )  ,IX(8),1T!10},IA{9),IN!9) 

COMMON/ WAL  f/LIXK  , NG1FRR 

LOMMCN/tONTRL/IT!  S  TG  ,  I  P.A  YSK  ,  I ENTLV,  I  VOLUM,  I  WOT  ,  1  TAPED,  NO  ,  I  YES 
COMMfU/ENGEOM/Lf-  GFGM 
COMMON/ S  l/E/NOC 
COMMON/ t-RR/IEKR  > 

COMMON/. <ANDM./ I  KANOM 
EOUIVALFNCE  ( A S I LR, MASTER  ) 

901  FOXMAI ( lHl,3?nrnIS  IS  THE  li  APR  69  VtRSION  OF  / 

I  ll<  ,  32li  I  HP  URL  CSC  MAGIC  PROGRAM  ******  //) 

902  H.RMATU6H  BEGIN  EXECUTION) 

903  format (piio) 

904  FoRMAH IUO, lOx,4  2H!Ht  TAPE  4  USED  FOR  THIS  RUN  HAS  I  HE  TITLE  / 

1  10A6/ ) 

905  FORMAT! IHO, tOHcNTlK  GFN( ) 

906  FORMAT!  1  HO,  121ILFAV  IMG  G!N1) 

90?  FORMAT  !  IHO,  OSHTi-KMlNATIOM  ON  GEOMETRY  INPUT  ERROR ,  5X ,  5H I  ERR=  ,  I  5  ) 
906  FORMAT !  IHI ,  15I1TFSTG  IS  CALLED) 

909  FORMAT! IHO, 13HLE AVI  MG  Tf  STG ) 

910  FORMAT! 1 H 1 , 24HKE  i.  I ( N  IYPE  DATA  FOLLOWS,  8X,6HL 1kF0=, 1 10/ 

1  111  ,6liREG  10N,6X,4HC0GE,6X  ,4Hf  YPF,6X,  1  1HUESCRIPT  ION/) 

911  FORMAT!  IHO, 10X, 6A6) 

912  FORMAT! 16, I  10, 19, ?X,6A6) 

913  FORMAT!  IHO, 23).N0  ROOM  FOR  IOENT  I ABL E , 5 X , 7HL £GE0M= , I  7, 5X , 

1  6HL I RFC= ,17) 

914  FOkMA I ( 1  HO*  32MWR I TE  IAPE  l  OPTION  IS  SPECIFIED) 

915  FORMAT! ) 5,  1)X, 10A6) 

916  FORMAT!  IHI,  Llht.NTFR  VOLUM) 

917  FORMA! (IHO, 13HLCAV1NG  VOLUM) 

918  FORMA f { 1 H  ,6H  999.9) 

919  FORMAT! LH1 , llHENF  OF  CASE, 15) 

925  FORMAT! 1H1,3?UNUM  OF  ASPECT  ANGLES  FOR  GRIU  IS, 15) 

927  FORMAT! 1015) 

928  FORMAT!  IHI  .32HI1UM  OF  ASPECT  ANGLES  FOR  AREA  IS, 15) 

929  FJKMAT!1H0,31HNUMBC-K  OF  Gl  fcRRORS  ENCOUNTERED,  I  5 ) 

930  FORMAT! IHO, 31HNUMHLK  CF  o  ITEMS  ENCOUNTERFU, I s ) 

999  FORMAT!  1  HD,  10H6.ND  oF  RUN) 

IRANPM=0 
WRITE  ( a , 90 1 1 
WR1IC  (6,902) 

I  15  =  2**15 
130=2**30 
P  I  NF= l • 0E30 
N0=0 
I YtS=  1 
ILRR=L 
LOASE= 1 
KL0OP=0 
N00=30000 

KE AO  (5,903) IRDTP4, 1WRIP4, IfESTG, IRAYSK, I  CARD  I , I LNTLV, I VOLUM 


MAIN  l 
MAIN  2 
MAIN  3 
MAIN  4 
MAIN  5 
MAIN  6 
MAIN  7 
MAIN  8 
MAIN  9 
MAIN  10 
MAIN  11 
MAIN  12 
MAIN  13 
MAIN  14 
MAIN  15 
MAIN  16 
MA IN  17 
MAIN  16 
MAIN  1'/ 
MAIN  20 
MAIN  21 
MAIN  22 
MAIN  23 
MAIN  24 
MAIN  25 
MAIN  26 
MAIN  27 
MAIN  28 
MAIN  29 
MAIN  30 
MAIN  31 
MAIN  32 
MAIN  33 
MAIN  34 
MAIN  35 
MAIN  36 
MAIN  37 
MAIN  38 
MA  I N  3'4 
MAIN  40 
MAIN  41 
MAIN  42 
MAIN  4  3, 
MAIN  44’ 
MAIN  45 
MAIN  46 
MAIN  47 
MAIN  48 
MAIN  49 
MAIN  50 
MAIN  51 
MAIN  52 
MAIN  53 
MAIN  54 
MAIN  55 
MAIN  56 
MAIN  57 
MAIN  58 
MAIN  59 
MAIN  60 
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noon  000000:0  000  000  o  r  r>  o  o 


I F  <  IR0TP4.  Nfc. OHRO  TP  4=  IYES 
1H  IWRTP4.NE.0)IWRTP4=IYES 
IF<ITCSIG.Nt.O)ITESTG=lYES 
If ( 1RAYSK.NE.C)IRAYSK=IYES 
IK  lCARDI.NE.O)ICARDI=IYES 
IF( IENTLV.NE.0)IENTLV=IYES 
I F ( I VOLUM.Nfc .0 ) I VOLUM= I  YES 
C 

lr( IR0TP4.EQ.M0)  GOTO  10 

READ  (4)  DUMMY, ASTER, LBASE, PINF, IERR»NRPP»NTRiP,NSCAl, 

1  NBODY',NRMAX,LTRIP»LSCAL  »LREGD» LDATA, LR IN.LROT , L  1 0, LOCO A, 

2  LbGDY,LIRfO,SCALE,LRI,LRO,PINF, IT 
WRITE  (6,90AM  ini),  1  =  1. 10) 

GOTO  20 

PROCESS  GEOME  TRY 

10  00  11  I=L3ASE,NUG 
ASTER! I ) =0. 

11  CONTINUE 

WRITE  (6,905) 

CALL  GEM 
WRITf  (6,906) 

I  ERR  =  0 

IF( IbKR.LE.OJGOTC  12 
WkITL  ( 6 , 90  7 ) I  ERR 
STOP 

12  I F ( IKRTP4 . EQ.NO) GOTO  20 

WRITF (4)  DUMMY, ASTER, LB AS E, P INF, IFRR,NRPP»NTRIP»NSCAL» 

1  NBODY.NRMAX , LTRI P, LSCAL  yLKEGO, LOATA,LRIN,LROT,LIO,LOCOA, 

2  LBOOY , LI RFO , SC  ALE, LR I , LRO, PI NF , I T 

TEST  G 

20  IF ( ITESTG.EQ.N01G0T0  30 
WRITF  (6,908) 

CALL  TESTG 
WRITE  (6,909) 

I  TESTG=NO 

VOLUM 

30  IF( IV0LUM.EQ.N0)G0T0  40 
WRITE  (6,916) 

CALL  VOLUM 
WRITE  (6,917) 

I  V0LUM=N0 

REGION  TYPE  DATA  /  ICODE  /  IDENT  / 


IRN  *  REGION  NUMBER 
ICODE  =  ITEM  CODE 

IUENT  =  SPACE  CODE  AND  SPECIAL  IDENTIFICATION 
0  NO  IDENT  COOE 

10,20,30,40,50,60,70,80,90  SPECIAL  IDENTIFICATION 
SK I RT=  lu  ARM0R=20  TARGET*30 
-1,  1-9,11-19,21-29, . ,91-99  SPACE  CODES 


MAIN  61 
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MAIN  116 
MAIN  117 
MAIN  118 
MAIN  119 
MAIN  120 
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40  L I RF0=NDQ-NRMAX- 10 

IFILlRFG.GT.LtGE0M)G0T0  4i 
Wrt I TE ( 6  »  913 ) LEGE 0M»L IRFO 
STOP 

4  i  milTc  I o ,910 ) L  iRf  0 
MASIfcR(L  IKF0-1  )=I15*1 

42  KEA0l5,9li)  IXN,I  CODE,  I  DENT,  (All), 1  =  1, 6) 
IH  IKNoLE.OJGGTO  50 

WKI  Tt  (6,912) IRN, I  CODE, I0ENT, (At  11,1  =  1,6) 

IDENT=U)ENT  +  1 

K=LIRE0*IRN-1 

PAS  TER ( K  )  =  I  CODE* 1 1 6* 1  DENT 

GO! 0  42 

NOaA  =  NUM  OH  ASPLC1  ANGLES  FOR  GRID 
IIAPE8  IS  1HE  SUPKLSS  PRINTER  OPTION 
IWOI  IS  WRITE  OP  I  1  ON  FOR  TAPE  1 
NARtrA  =  NON  OF  ASPECT  ANGLES  FOR  AREA 

50  READ  { 5 , 927 ) No AA , I  WO  T , I i APF8, NAR  E A 
IF ( IWOT.NL.O) l WJ  T  =  1  YES 

IK  1 1  APL8.E0.W  JGOTO  51 
( TAPE  3= NO 
GO  10  62 

51  1 TAPLC= 1  YES 

52  1 F (  I  WO  I . EO.NO ) GO  TO  60 
REWIND  1 

WRlTh  (6,914) 

WRITE (1, 915 )NOAA,{ IT(I), I =1,10) 


GRID 

60  IFINOAA.LE.OJgOTG  70 
WRITE  (6,925) NOAA 

DO  61  1=1, NOAA 
CALL  GRID 

IF( I  WOT. EG. I YES) WRITE ( 1,918) 

WRITE  (6,919)1 

WRITE  (6,929) I  ERR 

WRUL  (6,930)  ItRRO 

ItRR=0 

1 6RK0=0 

61  CONTINUE 

AREA 

70  If (NAREA.LE.O)GOIO  99 
WRITE  (6,928) NAR  £ A 

00  71  1= l.NARLA 
CALL  AREA 
WRITE  (6,919)1 
I  ERR  =  0 

71  CONTINUL 

99  WRITE  (6,999) 

STOP 

END 
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SUEROUT I N£  UN2IL.J1.J2) 

UNPACKS  2  ITEMS  FROM  THE  MASTER-ASTER  ARRAY 
COMMON  MASTER! 30000) 

I3=MASTER{ L) 

Jl-13/32768 

J2=I3-Jl*3276fi 

RETURN 

END 


SUBROUTINE  UN3 (L , J 1, J2 , J3 ) 

UNPACKS  3  ITEMS  FROM  G1  STORAGE 
COMMON  MASTERI30000) 

I3=MASTER(L) 

l 2- 13/32768 

Jl=I2/64 

J2=I2-Ji*64 

J3= I  3- 1 2*32768 

RETURN 

END 


SUBROUTINE  OPENK { L , J I , J2 , J3 ) 

COMMON/ G TRACK/ 01 .D2.KHIT, LMAX, TR(200)»XBSt3) • IRSTRT  j I ENC  » 
1  ITR(200),CA, CE.SA.SE 

I 

UNPACKS  3  ITEMS  FROM  COMPONENT  LINE  OF  SIGHT  STORAGE  ITR 
/  SURFACE  NUM  /  BODY  NUM  /  NEXT  REGION  / 

13= I TR ( L  ) 

12=13/4096 

J 1= 12/4096 

J2= I 2-J 1*4096 

J3=I3-I2*4096 

RETURN 

END 


FUNCTION  RAN ( M ) 
COMMON/RANDM/IRN 

C  GENERATES  RANDOM  NUMBERS 

RAN=URAN3l ( IRN ) 

RETURN 

END 

C 

C 

FUNCTION  URAN3M  I ) 

IF ( I ) 20 . 10 . 20 
10  1=11111111 
20  J=I 
J=J*25 

J=J-( J/67108864) *67108664 
J=J*?5 

J=J-( J/67108864) *67108864 
J=J*5 

J=J-( J/67108864) *67108864 


MAIN  181 
MAIN  182 
****  1 
UN  2  2 
UN2  3 
UN2  4 
UN2  5 
UN2  6 
UN2  7 
UN2  8 
UN2  9 
UN2  10 
****  2 
UN3  2 
UN3  3 
UN3  4 
UN3  5 
UN3  6 
UN3  7 
UN3  8 
UN3  9 
UN3  10 
UN3  11 
UN  3  12 
****  3 
OPENK  2 
OPENK  3 
OPENK  4 
OPENK  j 
OPENK  6 
OPENK  7 
OPENK  8 
OPENK  9 
OPENK  10 
OPENK  11 
OPENK  12 
OPENK  13 
OPENK  14 
OPENK  15 
OPENK  16 

****  4 

RAN  2 
RAN  3 
RAN  4 
RAN  5 
RAN  6 
RAN  7 
RAN  8 
***♦  5 
URAN31  2 
URAN31  3 
URAN31  4 
URAN31  5 
URAN31  6 
URAN31  7 
URAN31  8 
URAN31  9 
URAN3110 
URAN3111 
URAN3112 


n  o  n  o  n  n  00000  n  n  o  nr-  n  no  r  on 


UKAN31=A1/671G8564. 

RE  I 'JRU 

END 


SU8KGUT  i  Nf:  CKO  Si  ( ANSWER, F 1RST, SECOND ) 

DIMENSION  ANSWER  I  3), FIRST (3), SECOND! 3) 

Computes  cross  product  answer  =  first  x  second 

ANSWER! I )  =  FIRST ( 2) ^SECOND! 3)  -  FIRST t 3 )*SECONO( 2 } 
ANSWER  ( 2  )  =  FlRST(3)*SeC0ND(n  -  FIRST  II)  «=S  ECONO  (  3  ) 
ANSWER  (  3  )  =  F l RST ! I ) ^SECOND l 2 )  -  FIRST  ( 2  )  *SECONO!  1  ) 
RFTUKN 
END 


PUNC1I0N  00  T ( F IRST ,  S ECONO ) 

DIMENSION  FIRST! 3) , SECOND (3 ) 

CGKRJUJES  00!  PKOOUCI  DOT  =  FIRST  .  SECOND 

DOT  =  F  IRSTm  ^SIXjJNlM  l )  ♦FUST  121  <=SEC^ND!  2  )  ♦  H  RS  I !  3  ) *SEC0N0(  3  ) 

Rt:  I  URN  " - - 

END 


SUHrCOT  I NE  UMKVI 
01 Mt  NSIuN  VI 3) 

COMPUTES  UNIT  VrrCTOk 
TEMP  =  SORT 10GTI V, V) ) 

V t 1 1 = V ( 1 J/IEMP 
V { 2 ) = V ( 2 ) / TEMP 
V !  3  )  =  V  I  3  )  /  Tt'MP 
RE  1  URN 
END 


SUtikOUT  1  Nfc  OR  I  IC  (C  ,K  *NKE  ) 

SOLVES  A  POLYNOMIAL  COUATION  OF  THE  TYPE 

X**4  +  C(l»*X**3  ♦  C 1 2 )  *X**2  ♦  CU)*X  ♦  CI4)  r  0 
THE  COEFFICIENT  OF  X**4  IS  ASSUMED  TO  BE  1 
R  CONTAINS  THE-  RC01S 

NKE  CONTAINS  THU  NUMBER  OF  REAL  ROOTS 

IF  I  HERE  ARE  TWO  Rt-.AL  ROOTS  THEY  WILL  BE  IN  Rll)  AND  RI2), 
WITH  THE  COMPLEX  ROOTS  R13)  +-  R(4!*l 
IF  THERf:  ARE  NO  KFaL  ROOTS,  THE  COMPLEX  ROOTS  AaE 
Rll)  +-  R(2)*I  AND  R ( 3 )  ♦  -  R(4)*I 

01  MEN  SI  ON  C(4)  ,R  (4),CPm  ,Y(3) 

C1SQ=C(  1  )**2 
CP! I ) =-C  1 2 ) 

CP ( 2  )  =C ( l)*C(3)-4.*C(4) 

CPt3)=(4.*C(2)-ClS0)*C(4)-C(3)**2 
CALL  CUB IC ( CP , Y, NKL ) 

A=ClSG/4.-C(?)+Y(l) 

B  =  «  5  *  C  ( 1 )  *  Y  ( I)-C (3) 

0=.25*Y(  1 )**2-C( 4 ) 

IF! A.GT.C. )GOTO  10 
L  =  0. 

GOTO  20 
10  E=SQR 1(A) 

20  IFID.GT.O. 1G0T0  30 


URAN3113 
URAN3114 
URAN3115 
URAN3116 
URAN3117 
****  6 
CROSS  2 
CROSS  3 
CROSS  4 
CROSS  5 
CROSS  o 
CROSS  7 
CROSS  8 
CROSS  9 
CROSS  10 
****  7 
DOT  2 
DOT  3 
DOT  4 
DOT  1 
DOT  6 
DOT  7 
DOT  8 
****  8 
UNIT  2 
UNIT  3 
UNIT  4 
UNIT  5 
UNIT  6 
UNIT  7 
UNIT  U 
UNIT  9 
UNIT  10 
UNIT  11 
****  9 

QR1IC  2 
0RT1C  3 
OR  T I C  4 
QRTIC  5 
GKTIC  6 
QRTIC  7 
QRTIC  8 
QRTIC  9 
QRTIC  10 
QRTIC  11 
QRTIC  12 
QRTIC  13 
QRTIC  14 
QRTIC  15 
QRTIC  16 
QRTIC  17 
QRTIC  18 
QRTIC  19 
QRTIC  20 
QRTIC  21 
QRTIC  22 
QRTIC  23 
QRTIC  24 
QRTIC  25 
QRTIC  26 


o  o  c ■>  o  o  o  r:  n  o  on 


F=0. 

GOTO  50 

30  F  =  $ I GN ( SORT (U) ,B ) 

50  NKF=0 

REAL=-«25*C(  1 )  •*-.  5*L 
USC*=REAL**2-.5*Y( 1)*F 
RA0=S0RT{ ABSIOSCR) I 
IHOSCR.LT.G.  IGOTO  60 
NkE  =  2 

R( 1)=RFAL+RA0 
K(2)=KEAL-RAD 
GOTO  65 
60  R( 3 ) =REAL 
K ( 4 ) =KAO 
66  R6AL=RE AL-F 

DSCR=REAL**2-.5*Y( 1 1  — F 

KAD=SOR  I  ( A8S (DSCK ) ) 

IFIOSCR.LT.O. )GOTO  80 

NKG=NR£+2 

K( NRE ) =REAL-RAO 

R( NRE-1 ) =REAL+RAD 

RETURN 

80  R(NR£+l i =REAL 
Rt  NRF  +  2 )  =RAl) 

RETURN 

ENU 


SUBROUTINE  CUBIC <C,R, NRE) 

SOLVES  A  POLYNOMIAL  EQUATION  OF  THE  TYPE 
X**3  +  C(1)*X**2  ♦  C(2J*X  ♦  C  (  3 )  =  0 
THE  COEFFICIENT  OF  X**3  IS  ASSUMED  TO  BE  1 
R  CONTAINS  THE  ROOTS 

NRE  CONTAINS  THE  NUMBER  OF  REAL  ROOTS 
IF  THERE  IS  ONE  REAL  ROOT  IT  WILL  BE  IN  RID, 
WITH  I  HE  COMPLEX  ROOTS  RI2)  +-  K  <  3  > ♦ I 

OIMENSION  C ( 3  )  »R ( 3 ) 

C1SQ=C(1)**2 
P=C ( 2  I -C 1SG/3. 

Q=C(3)-Ctl)*(C(2 )/3.-2.*ClSQ/27.  I 

0£L=4.*P**3+27.*Q**2. 

r=C(l)/3. 

IFIOEL.LT. 0. IGOTO  10 
SQ=SQRT (UEL/108. ) 

HQ=.5*Q 

A=-HO+SQ 

B=-IIQ-SU 

CRTA=SIGN'.  A8SIA)  **.333333  33  33333333,  A) 

CRTB=SIGN( ABS(B) **.3333333333333333, B) 

Y=CkTA+CRTB 

Kill =Y-T 

R ( 2 ) =-• 5*Y-T 

R(  3 )  =  . 866025404* (CRTA-CRTB) 

NRE=  1 
RETURN 

10  PH  I3*ATAN2(SQRT(.-D  EL/27. ),-Q)/3. 
C0N=2.*SQRT(-P/3.) 

R( 1)=C0N*C0S(PHI 3 ) — T  80 


QRTIC  27 
QftTIC  28 
QRTIC  29 
QRTIC  30 
QRTIC  31 
QRTIC  32 
QRTIC  33 
QRTIC  34 
QRTIC  35 
QRTIC  36 
QRTIC  37 
QRTIC  38 
QRTIC  39 
QRTIC  40 
QRTIC  41 
QRTIC  42 
QRTIC  43 
QRTIC  44 

QRTIC  45  I 

QRTIC  46 
QRTIC  47 
QRTIC  48 

QRTIC  49  I 

QRTIC  50  I 

QRTIC  51 

QRTIC  52 

QRTIC  53 

QRTIC  54 

****  10 

CUBIC  2 

CUBIC  3 

CUBIC  4 

CUBIC  5  ! 

CUBIC  6  • 

CUBIC  7 

CUBIC  8 

CUBIC  9 

CUBIC  10  ! 

CUBIC  11 

CUBIC  12  ! 

CUBIC  13  . 

CUBIC  14  1 

CUBIC  15  1 

CUBIC  16  ‘ 

CUBIC  17 

CUBIC  18  ( 

CUBIC  19  | 

CUBIC  20  j 

CUBIC  21 

CUBIC  22  j 

CUBIC  23  ! 

CUBIC  24 
CUBIC  25 
CUBIC  26 
CUBIC  27 

CUBIC  28  j 

CUBIC  29  I 

CUBIC  30  1 

CUBIC  31 

CUBIC  32  j 


nooo  o  o  o  c~  o  o  o 


10 


C 

C 

C 

C 


10 


10 


RI2)=-C0N*C0SU.04  719755-PHI3)-T 

CUBIC  33 

K(3)=-C0N*C0S( 1.04719755+PH13)-T 

•  CUBIC  34 

NKE  =  3 

CUBIC  35 

RETURN 

CUBIC  36 

END 

CUBIC  37 
CUBIC  38 
CUBIC  39 

FUNCTION  XI)  I  S  T  ( X  A ,  XB  ) 

****  11 

coMHures  ihe  distance  between  xa  and  xb 

XDIST  2 

DIMENSION  X A ( 3 ) ♦ XB ( 3 ) 

XDIST  3 

XSUM=0. 

XDIST  4 

Do  10  1=1,3 

XDIST  5 

XSUM=XSUM+(XA(  D-XBC  I  )  )**?. 

XDIST  6 

CONTINUL 

XDIST  7 

XOISr=SURT(XSUM) 

XDIST  H 

RETURN 

XO 1ST  9 

END 

XDIST  10 
XDIST  11 
XDIST  12 

SUBROUTINE  DCuSlMXA,  XB,WA  ) 

****  12 

COMPUTES  DIRECTION  COSINES  FROM  POINT  XA  TO  POINT  XB 

DCOSP  2 

AND  STORES  DIRECTION  COSINES  IN  wA 

DCOSP  3 

DIMENSION  XAI3), XR(3),WA( 3) 

DCOSP  4 

DI S=XDI ST ( XA » XB) 

DCOSP  5 

00  10  1=1,3 

DCOSP  6 

WAT  I )  =  (XB< I J-XAT  I ) )/OIS 

DCOSP  7 

CONTINUE 

DCOSP  8 

RETURN 

DCOSP  9 

END 

DCOSP  10 
DCOSP  11 
DCOSP  12 

SUBROUTINE  TROPICTWP) 

*♦**  13 

GENERATES  RANDOM  DIRECTION  COSINES  FROM  AN 

TROPIC  2 

ISOTROPIC  DISTRIBUTION 

TROPIC  3 

0 1 MENS  I  ON  WP ( 3 ) 

TROPIC  4 

X l=KAN  (-1) 

TROPIC  5 

X2=K AN  (-1) 

TROPIC  6 

XIS=X1*«2 

TROPIC  7 

X2S=X2**2 

TROPIC  6 

T=X1S+X2S 

TROPIC  9 

i  f  t r.cE.  i. )goto  10 

TROPICIO 

CALC  SIN  AND  CCS  OF  A  RANDOM  ANGLE  PHI 

TROPIC  11 

CSPHI=(X1S-X2S)/T 

TROP I C 12 

SNPHI =( 2.*Xl*X2) /T 

TROPIC  13 

X1=RAN  (-1) 

TROP  1 C 14 

IFTXI.IE..5)SNPHI=-SNPHI 

TROP I C 15 

CALC  COS  AND  SIN  OF  RANDOM  ANGLE  THT 

TR0PIC16 

CSTHI=?.«RAN  (-I)-l. 

TR0PIC17 

SNTHT=SQRT( 1 .-CS 1HT**2 ) 

TR0PIC18 

CALC  DIRECTION  COSINES 

TK0PIC19 

WP  (  1  >=SNTHT*SNPH  I 

TR0PIC20 

WPI2)=SNTHT*CSPH I 

TR0PIC21 

WP ( 3 ) =CSTHT 

TROPIC22 

RETURN 

TR0P1C23 

END 

TR0PIC24 

TR0PIC25 

TR0PIC26 

TR0PIC27 

81 

TROPIC28 

SUBROUTINE  GFN I 

****  14 

DIMENSION  MASTER (30000) , I fY ( H ) , I AN< 8) , I AA(8 ) * FXl 20 > * 

1  NOO ( 3 1 »N0 1 1  3 ) » N02! 3 ) , 04 ( 3 ) , T T< 3 ) , TT 1 ( 3 ) . TT2< 3 ) ,NBOO( 1 1 ) 
COMMON  ASTER ( 30000 ) 

COMKON/GFOM/LWASL,RlN,RGUr,LRI,LRO,PlNF,  16RR,DIST 
COMMON /UNCGEM./ NR  PP,NTRIP,NSCAL  «N BODY ,NRMAX,L TRIP, LSCALyLREGD, 
l  LDA) A , LR IN , LRO T , L l O.LOCOA  1 1 1 5* I3O,LB0DY,NASC,KLOOP 
COMMON/ 1EMP0R/XS(6)»X(6)»IX(8),IT(IQ)»IA(9),IN(9) 
CJMMON/CONTRL/I fESTG,IRAYSK,IENTLV,IVOLUM,IHOTt I TAPE8, NO, IYES 
COMMON/ S  Ut/NGO 


GENI  6 


GEN  I  10 


COMMON/UNCLE/NN, 1C ( 4 ) 

GENI 

11 

COMMON/ RRPP/LRPPD, LA BUT 

GENI 

12 

CUUIVALlNCEI ASTER.MASTEK) 

GENI 

13 

GENI 

14 

901  FORMAT! 1H0,24HSTART  READING  SOLID  DATA) 

GENI 

15 

902  format U0A6) 

GENI 

16 

903  FORMAT (1N0,10A6/) 

GENI 

17 

904  FORMAT! 71 10) 

GENI 

18 

905  FORMAT (4X,34HN0.  OF  RECTANGULAR  PARALLELEPIPEDS, 

110/ 

GENI 

19 

1  4X , 34HN0.  OF  TRIPLETS  , 

110/ 

GENI 

20 

2  4X » 34HN0.  OF  SCALERS  , 

i  10/ 

GENI 

21 

3  h X , 3AHN0.  OF  SOLIDS  , 

no/ 

GENI 

22 

4  AX, 34HMAX  NO.  OF  REGIONS  , 

110) 

GENI 

23 

906  FORMAT ( 1H0,45X,32HRECTAMGULAR  PARALLELEPIPED  INPUT)  GENI  24 

907  FORMAT ( L HO »37X»L2H TRIPLET  DATA)  GENI  25 

908  FORMAT (6E12.6)  GENI  26 

909  FORMAT  (18*1 7x»3F 12.5)  GENI  27 

910  FORMAT ( 1H0 , 25X , l 2HSCAL AR  DATA)  GENI  28 

911  FORMA) t IHO, 50X,2 2HDESCR I P TI  ON  OF  SOLIDS)  GfcNI  29 

912  FORMAT! 3A1,A3,A4,6F10. 5)  GENI  30 

913  FORMAT ( IHOi&HlTYPE  ,A3,27H  UOES  NOT  MATCH  WITH  AN  ITY)  GENI  31 

914  FORMAT (I9,1X,3A1,3X,A3,A4,3X,8I5)  GENI  32 

915  FORMAT!  1 8 , IX , 3A1 ,2X, A3 , A4 ,4X,6F12.5>  GENI  33 

916  F0KMAT(25X,6F12.5)  GENI  34 

917  FORMAT  I 1H0.38HN0  MORE  ROOM  FOR  SOLID  DATA  LDATA=,I10,  GENI  35 

1  5X , 5HLB0T= ,  1 10  ,  5X, 4HNDQ  =  *  110)  GENI  36 

918  FORMAT ( IH0.25HFI NISM  RFAOING  SOLID  DATA)  GfcNI  37 

919  FORMAT!  IHO,  5HLREGD,7H  LP.LGL ,  7H  LENLV  »7H  LRIN.7H  LROT ,  GENI  38 

I  7H  LI0.7H  LFGEOM/ 15,017)  GENI  39 

920  FORMAT! 1H1,36X»?3H REGION  COMBINATION  DATA)  GENI  40 

921  FORMAT ! 15, 1X,9(A2« 15) )  GfcNI  41 

922  FORMAT! 1H0,30HEKR0R  IN  DESCRIPTION  OF  REGION, 15,  GfcNI  42 

19H  IN  FIELD, 12, 5X.24HR0UY  MUM.GT.NRPP  ♦  NBODY)  GENI  43 

923  FORMAT! 10X, 9! 1H( ,A2, 15, 1H), IX) )  GENI  44 

924  FORMAT! I8,2X,9(IH( ,A2, 15, IH),1X) )  GfcNI  45 

925  FORMA! (1110, 30H1LLEGAL  OPERATOR  IN  ABOVE  CARD,5X,A2,  GENI  46 

l  9H  IN  FIELD, 12)  '  GENI  47 

926  FORMAT! 1H0,29HERR0K  IN  REGION  INPUT  IR=,I5,14H  OR  N.GT.NRMAX )  GENI  48 

927  FORMAT! 1HO.39HN0  MORE  ROOM  FOR  REGION  DATA  LDATA=,I10,  GENI  49 

l  5X,4HN0Q=* 1 10)  GENI  50 

928  FORMAT ( IH0.26HFI NI SH  READING  REGION  DATA)  GENI  51 

929  FORMAT ( 14H  ERROR,  REG  ION, 1 10, 1 8H  IS  PART  OF  REGION, 110)  GENI  52 

930  FORMAT  ( 24H  FINISH  CHECK.  I NG  REGION  ,15)  GENI  53 

931  FORMAT! 1H0,34HN0  MORt  ROOM  FOR  ENTER  LEAVE  TABLE, 5X,  GENI  54 

1  6HLDAT  A=»I10,5X, 4HNDQ= I10,5X,4HPASS»I2,5X,3HIR=,I10)  GENI  55 

932  FORMAT! 1H0,28HT0TAL  ROOM  FOR  GEOMETRY  DATA»5X,7HLEGE0M=, 16)  GENI  56 

933  FORMAT ( 1 HO »5H ENTER, 1816/ ! 23X, 151 6) )  GfcNI  57 

934  FORMAT  (  1H  ,  5HLEA  VF.  ,  18  1 6/ (  23X,  1  51  6  )  )  GENI  58 

935  FORMAT (1H1,50X,18H BEGIN  ARRAY  OUTPUT/)  GENI  59 

936  FORMAT (3(316, IX, Ell. 4, 3H  t  ))  GENI  60 

937  FORMAT!/)  GENI  61 
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938  FORMA T ( IHO » 34HFI N [ SH  A  PASS  OF  ENTER  LEAVE  TABLE, 15) 

GENI 

62 

939  FORMAT  (  IHO , 14H ERROR  PI  INPUT, 5X,  A3.23H 

DOES 

NOT  ALLOW  TRIPLET, 

GEN  I 

63 

1  22H  AND  SCALAR  TYPE  INPUT) 

GENI 

64 

940  FORMAT ( 10X,6F10.5) 

GENI 

65 

941  FORMAT ( 1H0 , 37HTERMINAT I ON  ON  BAD  REGION  DESCRIPTION) 

GENI 

66 

942  FORMAT  1 IHO , 32HERR0K  IN  DESCRIPTION  OF 

BODY  NUM, I 6/ 

GENI 

67 

1  7H  VECTOR, 3F 12.5,24H  IS  NOT  PERPENDICULAR  10  / 

GENI 

68 

2  7h  VECTOR, 3f  12. ‘i / ) 

GENI 

69 

943  FORMAT  I IHO , 27HERROR  IN  DESCRIPTION  OF 

TOR , 5X 

,8HR2.GT.Rl/) 

GENI 

70 

944  FORMA! { 1H0,27HERR0R  IN  DESCRIPTION  OF 

TRC,5X 

, 7HR1  =  R2/ ) 

GENI 

71 

945  FORMAT  (IHO,  5HL8ASE,7FI  LRPPD, 

GENI 

72 

t  7H  LABUT , 7H  LB00Y.7H  LB00,7H 

LUATA, 

7H  LBOT , 7H  LSCAL, 

GENI 

73 

2  7H  LTRIP.7H  ND0/I5.9I7) 

GENI 

74 

946  FORMAT ( 1H1 » l 7HEN  TEK-LEAVE  TABLE) 

GENI 

75 

947  FURMATl IHO, 1 1 ( 2X , A3) /I 1 I 5 ) 

GENI 

76 

948  FORMAT ( 1H0,27HERR0R  IN  DESCRIPTION  OF 

TEC,5X 

, 

GENI 

77 

l  41HHEIGHT  VECTOR  IS  PARALLEL  TO  BASE  ELLIPSE) 

GENI 

78 

GENI 

79 

GLNI 

80 

INTEGER  HH8GX, HHSPh, HHKCC ,HHREC, HHTRC , 

HHELL, 

HHRAW,HHARBVHHTEC, 

GENI 

81 

1  HHTOR ,  HHARS  , HH'J  R ,  HHCR,  HHR,  hHRA,  HHAR  ,  HH8A, HHA,  HUB 

GENI 

82 

GENI 

83 

DATA  HHBOX, HHSPH, HHKCC, HHRtC, HHTRC, HHELL, HHR AW, HHARB,. 

GENI 

84 

I  HUT EC ,HHTOR»HHAKS/ jHBOX, 3HSPH, 3HRCC, 3HREC,3HIRC, 

GENI 

85 

23HELL,3HRAW,3HARK,  3HTEC,  3HT0R,  3HARS7 

GENI 

86 

DAI  A  HHOK,HHBK,HhR,HHRA,HHAK,HHBA,HHA, 

HHB 

GENI 

87 

l/2HOf<,2HBR,  1  HR,  2  HR  A,  ?HAR,  2H  A,  2HA  ,2H 

/ 

GENI 

88 

1 1  Y (  l ) =HHBOX 

GENI 

89 

I I Y ( 2 ) =HHSPH 

GENI 

90 

I T  Y  C  3 ) =HHRCC 

GENI 

91 

1  T  Y ( 4 ) =HHREC 

GENI 

92 

11 Y(5)=HHTRC 

GENI 

93 

1 1 Y (6 ) =HHELL 

GENI 

94 

ITY(7)=HHKAW 

GENI 

95 

I  TY ( 8 ) =HHARB 

GENI 

96 

I  TY ( 9 ) =HHTEC 

GENI 

97 

I T  Y ( 10 ) =HHTOK 

GENI 

.  98 

I  T  Y ( 1 1 ) =HHARS 

GENI 

99 

I  AM{ 1 )  =  1 

GENI 

io'o 

IAN( 2)=1 

GENI 

,101 

I  AN ( 3 )  =  1 

GENI 

102 

IAN ( 4 ) =2 

GENI 

103 

I  AN ( 5 ) =2 

GENI 

104 

I  AN ( 6 )  =  3 

GENI 

105 

IAN(7)=3 

GENI 

106 

1  AN ( 8 ) =4 

GENI 

•107 

I  AA ( 1 ) =HHOR 

GENI 

108 

IAA(2)=HHBR 

GENI 

109 

I AA ( 3 ) =HHR 

J 

G.ENI 

110 

1 AA (4 ) =HHRA 

Gfj'NI 

111 

I  AA  (  5  )=IIHAR 

GENI 

112 

IAA(6)=HHBA 

.  GENI 

113 

IAA( 7 )=HHA 

GENI 

114 

I  AA ( d ) =HHB 

GtNl 

115 

IBL=HHB 

,  GENI 

116 

GENI 

117 

gen! 

118 

WRITE  (6,901) 

GENI 

119 

READ ( 5 , 902 ) ( I T ( I ), 1=1,10) 

t 

GENI 

120 

WRITE  (6,903) (1 T{ I), 1=1, 10) 

1 

GENI 

121 

83 


i  i 


i 


oooc'oo  o  r>  r>  or.  o 


V 


) 

l 


REAUI6, 904JNRPP,NTRIP,NSCAL,N300Y,NRMAX,  IPRIN,  IRCHEK 
«K1  TF  ( 6 , 905 ) NK  PP ,N  T  R 1 P , NSCAL  *NB0DY  *NRMAX 
C 

0  KPP 

C 

WRlTF  (6,906) 

L  AK  =  l 

IF  (NKPP.Lt.OJC.OrO  20 
CALL  RPPINILAR) 

1 F  (  i rKR*  GT  *0 )  RETURN 
C 

C  LBODY  SfORAot  RESERVE  3* I NRPP+NBODY )  WORDS 

G  /  HYPE  /  LDATA  / 

0  /  L.iC  ENTlR  LIST  /  LOG  LEAVE  LIST  / 

f.  /  NUM  ENIrR  /  NUK  LEAVE  / 

C 

C  LUATA  POINTS  TO  BODY  POINTERS  STORED  AT  LQOD 

G 

20  LTRlP=N0U-3*NTRl P+1 
LSCAL=LTRIP-NSCAL 
LbOT-LSCAL 
L  =  L  AK 
LRuUY  =  L  +  1 

LUA  [  A  =  Ll>0DY  +  3*  (NBQCY+NRPP  ) 

LBOO-LOA  I  A 

r  K  I  P  L  L  T  S 

l  F  I N I  K  l  P .  E  Q .  0  )  GO  T  0  30 
WR  i  TL  (6,907) 

GO  21  1=1, NIK  IP 
1  l  =  L I R I  P  +  3* (  1-1) 

12=11+2 

ReAD I  5,908)1  ASTER (K) ,K=I 1,12) 

WK  I  I  L  16,909) (  I, (AST  ERIK ),K= 1 1, 12)) 

21  CONTINUE 

SCALARS 

30  I F ( NSCAL . EO.C ) GOTO  SO 
i  1  =  LSC AL 
12=1 l+NSCAL-1 
WRIIt  ( o,9 10) 

DO  31  1=11,12 
J=I-Il+l 

REA0(5»908)ASTGR( I ) 

WRITE  (6,909) J, ASTER! I ) 

31  CONTINUE 

READ  AND  PROCESS  300 1 ES 

50  WRITE  (6,911) 

LOOP  TO  PROCESS  SOLTOS 

DO  370  N=  l ,  NI300Y 
NN=N+NRPP 
L  S  1  =0 

REAOl  5,9  12)  IC(1>,  IC12),  IC<3>,  ITYPE,lCm,<FX(K),K=l»6) 
DO  51  1=1,11 


GENI  122 
GENI  123 
GENI  124 
GENI  125 
GENI  126 
GENI  127 
GENI  12H 
GENI  129 
GENI  130 
GENI  131 
GENI  132 
GENI  133 
GENI  134 
GENI  135 
GENI  136 
GENI  137 
GENI  138 
GENI  139 
GENI  140 
GENI  141 
GENI  142 
GENI  143 
GENI  144 
GENI  145 
GENI  146 
GENI  147 
GENI  148 
GfcNI  149 
GENI  150 
GENI  151 
GENI  152 
GENI  153 
GFN I  154 
GENI  155 
GENI  156 
GENI  157 
GENI  158 
GENI  159 
GENI  160 
GENI  161 
GENI  162 
GENI  163 
GENI  164 
GENI  165 
GENI  166 
GENI  167 
GENI  168 
GENI  169 
GENI  170 
GENI  171 
GENI  172 
GENI  173 
GENI  174 
GENI  175 
GENI  176 
GENI  177 
GENI  178 
GENI  179 
GENI  180 
GENI  181 
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IF{  ITYPE.EO.ITYt  I)  JGOTO  52 
CONTINUE 

WHITE  16*913) I TYPE 
STOP 
I TYPE= I 

NBOOC I  )=NBOD{  I ) ■*•  1 
K=LB0DY+3*( NRPP+N-l) 

HAS  T6R1 K ) =1  TYPE* 1 1 5+LDA  f  A 
1F(IC(1).NE.IHL)G0T0  200 


BOX  SPH  RCC 
GOTO! 101,103,102 
WHITE  ( 6 , 939 ) I TY 
STOP 
L*-=4 

GOTO  110 
LE  =  3 

GOTO  110 
Lfc  =  2 

GOTO  110 
l£=7 

CALL  C0NVRT(FX,1 
WKITt  (6,914) NN, 
LI -LTKIP-3 
Jl=lX(l) 

J2  =  I  X ( 2 ) 

J3=I  X ( 3 ) 

J4= I X ( 4 ) 

J5= IX i 5  ) 

J6=1X(6) 

J7= I  X { 7 ) 

BOX  SPH  RCC 
GOTO( 120, 130, 140 
BOX  REC  RAW 
MAST£R(LDATA)=(L 
MASt£R(LOATA+l)= 
LDATA=L0ATA+2 
GOTO  360 
SPH 

MAS TI.R (  L DATA  )  =  (L 
LDATA=LDATA+1 
GOTO  360 
RCC 

MASTEK(LOATA)=(L 
LDAT  A=LD AT  A+ l 
GOTO  360 

IRC  TOR 

MASTFR(LDATA)=(L 
MASTER(LGATA+1)= 
LOAT  A  =  LUAT  A+2 
GOTO  360 
ELL 

MASTER(LDATA)=(L 
LUA  T  A=LOAT  A-*- 1 
GOTO  360 
TGC 

MA  S  T  E  R  (  L  DA  T  A  )  =  ( L 
MASTER(LDATA+l)= 
MASTEK(LDATA+2)= 
LDATA=LDATA*3 


REC  TRC 
,101,101, 
(I  TYPE) 


ELL  RAW  ARB  TF.C  TOR  ARS 

102, 101, 100, 104, 101,100), I  TYPE 


X ,  LE ) 
IC(1),1C( 


2) ,IC(3),ITY(ITYP£),1C(4),(IX(J),J= 


REC  TRC 
,120,150, 

T+3*JI) *1 
LT+3*J4 


ELL  RAW  ARB  TEC  TOR  ARS 
160,120,100,170,150,100),  I  TYPE 

30+<LT+3*J2)*ll5+LT+3*J3 


T+3*J1)*I15+LSCAL+J2-1+I30 


I+3*J1)*I30+(LT+3*J2)*I 15+LSCAL+J3-1 


T+3*Jl)*I30+(LT+3*J2)*I 15+LSCAL+J3-1 
L  SCAL+J4- 1 


T+3*J1)*I30+(LT+3*J2)*I15+LSCAL+J3-1 


T+3*J1)*I30+(LT+3*J2)*I15+LT+3*J3 
(LT+3*J4) *I30+<LSCAL+J5-l)*I 15+LSCAL+J6- 1 
LSCAL+J7-1 


GEN  I 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GEN  I 
GENI 
GENI 
GENI 
GFNI 
GfcNI 
GENI 
GENI 
GtNI 
GENI 
GENI 
GEN! 
GfcNI 
GEN  I 
1,LE)  GENI 
GENI 
GENI 
GfcNI 
GENI 
GENI 
GENI 
GfcNI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
GENI 
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o  o 


L 


V, 


c 


c 


c 


c 


c 


c 

c 


uOTU  360 

GENI 

242 

GEN1 

243 

uox  sph  kcc  kuc  ikc  ell  raw  arb  tec 

TOR  ARS 

GENI 

244 

200 

«.0fo(201 ,220.202,201 ,20J,  202, 201, 230, 204, 

203,240), 

{TYPE 

GENI 

245 

201 

L^  =  12 

GENI 

246 

GO  10  21.1 

GEN! 

247 

202 

LL  =  I 

GENI 

248 

i.O  I c  21  - 

GENI 

249 

203 

le=  a 

GENI 

250 

l.OlU  210 

GEN! 

251 

204 

Il=  1  3 

GENI 

252 

210 

KK1  1C  (r.,9l5)NN,  iCU),ICU),IC(3),2TY(  ITfPE)  ,1C(4) 

, CFXI J),J*l,6) 

GENI 

253 

RLAL*(  5,940)  ( FX  ( J  )  ,  J=7,L6  ) 

GENI 

254 

WRITE  (6,916)  (FX(J),J=7*Lt) 

GENI 

255 

t'OX  SPH  rctc  KlC  TRC  ELL  RAW  ARB  TEC 

TOR  ARS 

GENI 

256 

t.ulu(29u, 300, 300, 200, 2B5,270,200, 300,260, 

250,300), 

I  TYPE 

GENI 

257 

GENI 

258 

22° 

M  1  T  F  (t<,916  JNN, 1C (1) , Ii (?) ,(C(3) ,1 TY( ( TYPE) ,IL(4) 

,(FX(J),J=1,4) 

GENI 

259 

Ov/Tti  10j 

GENI 

260 

A,U)  /  Hi  /  VI  /  6 

PER  AK8 

GENI 

261 

230 

WRt  Tt  1 6 ,1 1 0 ) NN, 1 C ( 1 ),IC(2)«IC(3),1TY( 1  TYPE) , IC(4) 

,(FX( J),J=i,6) 

GENI 

262 

CALL  ALOFRTIFX, LOOT, NOO, LSI) 

GcN  I 

263 

(•  o  I  0  16> 

GENI 

264 

APS  /  /  LUATA  t 

GENI 

265 

240 

CALL  ARI  til  LOO)  ,L  OA  TA  ,  MAS  T  FR  ,  AS  TER  ,  fWH) 

GLNI 

266 

i.OIO  360 

GENI 

267 

TOR  CONVERT  TO  UNIT  VECTOR 

GENI 

26fl 

250 

Tl  U)=Fx(4) 

GENI 

269 

I  1  (2)  -FM5I 

GENI 

2  70 

T  T  (  3 ) =F  X ( 6 ) 

GENI 

271 

CALI  li'l  IT  (  T  f  ) 

GENI 

272 

F  X  (  4  )  =  T  1  (  t  ) 

GENI 

273 

FX ( 3 )  =  T 1 ( 2  ) 

GtNI 

274 

FX(o)=Tf (3) 

GENI 

275 

1F(FX(7).G6.FX(8))G0T0  2ftO 

GENI 

276 

WKlIf  (o,943) 

GENI 

277 

I  EKR  = I ERKt l 

GENI 

278 

GOTO  230 

GENI 

279 

TEC 

GtNI 

280 

260 

F  X ( It)=FX( 13) 

GENI 

281 

Lb  =  15 

GENI 

282 

Till  1 ) =F  X 1 7 ) 

GENI 

283 

Tl ll?)=FX(8) 

GENI 

284 

TT1(3)=FX(9) 

GENI 

285 

TT2( 1 l=FX( 10) 

GENI 

286 

TT2(?)=FX(ll) 

GENI 

287 

TT2(3)=FX( 12) 

GENI 

28B 

IF(AHS(OOT(TTl,TT2)).LC.O.Ol)  GOTO  265 

GENI 

289 

WRITF  (o,942)NN, TT1.TT2 

GENI 

290 

l£RK= IFRR+1 

GENI 

291 

SEMI  MAJOR  AXIS  FX ( 13) 

GENI 

292 

265 

FX(  1  3 )  =  S OR T (DOT! I f 1 ,  T T  1 ) ) 

GENI 

293 

CALL  UN  1  1  ( T  T  1 ) 

GENI 

294 

FXl 10)=TTl(l) 

GENI 

2  95 

FX (11 1=111(2) 

. 

GENI 

296 

FX(  1 2 )  =  T  T 1 ( 3 ) 

GENI 

297 

SEMI  MINOR  AXIS  FX ( 1 4  ) 

GENI 

298 

FX ( 14 )  =  SORT ( 00 T ( TT2.TT2)  ) 

GENI 

299 

NORMAL  HEIGHT  VECTOR  g6 

CALL  CROSS (TT,TTl,TT2) 

GENI 

300 

GENI 

301 

CALL  UNI TC II> 

M0N*FX(4)*Tin  )*FX(5>*m2)  *FX(6)*rr  m 
IF(HI)NI?67,  266,268 
266  WI<ITFt6,94fll 
lEltK=lEKKM 
GOTO  260 

26  7  rmis-rrii) 
n (2)=-rri2) 
r r ( 3 ) =- r i ( j ) 

26«  fx( 7)  =  rr m 
FX(a»=rrc2» 

I-XI9I.-TIU) 

GOTO  28G 

c  kl  compute  foci 

270  IHICUI.EQ.IUUCOIO  300 

ASG-FX(4)*FX(4}*FX(:>)*FX(5) »FX(6) *FX(6) 

C  =  S!JK  l  {  ASO-F  X  (  7 1  *FX(  7)  ) 

A=S<JftT(  ASCII 

fx i  n-n*r^ 

C  X  ,  Y  ,  Z  COMPONFN  TS  OF  FOCI 

cx=c*rx<4)/A 

CY  =  C*FX  ( ‘i !  /  A 

c/=c*r-x(6i/A 

C  VfRItX  ♦  A NO  -  X,Y,Z  COMPONENTS  GIVE  THE  2  FOCI 

FXI4J-FXI  IHCX 
Fa  (  6  I  =F  a  (  2  I  +C  Y 
FX(6)=FX(3)*C7 
FX(1)=FX(1)-Cx 
FX ( ?) =FX ( 2 I-CY 
FX(3)=FX(3)-CZ 
C  PR  IN  I  NEW  INPUI 

280  WK I  I L  ( 0,915  INN, IC III , IC I  2) , t C 13  I , I T Y (II YPE ) , I C I  4 ) , t FX U > , J= l , 6  I 
WRIIF  (0,916) (FX(J),J=7,LC> 

GOTO  50u 

C  IRC  CHECK  Kl.Nc.R2 

285  IF  (  F  X  (  7  >  .NE  .  I  X  (0)  I  GOTO  300 
WRIIt  (6,944) 

IERR  =  IERR  +  l 
GOTO  300 

G  BOX  KAW  REC  CHECK  IF  VECTORS  ARE  PERP INDICULAR 

290  IF (Al3S(FX(4)*FX( 7)  ♦FX(5)*FX(fl) ♦FX(6)*FX(9) ) . LE . 0. 0 1 (GOTO  291 
WKI TE  (0,942  INN, (Fx( J) ,J=4,9) 

IERR  = IFRRf l 

291  IF(ABS(FX(4)*FX(10)*FX(6)»FX(U)+FXC6>*FX(12>>.LE.0.01 )GOTO  292 
WRI TF  (0,942  INN, FX(4),FX(5),FX(6),FX(I0),FX(11),FX(12) 

I ERU= I ERR*  l 

292  IF ( ABS ( FX ( 7) *IX( 10  I >FX ( ft  I *F X ( 1 1  I tFX ( 9  I *F X (  12)  I ,LE .0. 0 l ) GOTO  3C0 
WRITE  ( 0 ,942 ) NN# (FX(J),J= 7*121 

ICKRs IERR+  1 
C 

C  BOX  SPH  RCC  RLC  TRC  ELL  RAW  ARB  TEC  IOR  AKS 

300  GO  TO  (  3  l  J  ,  32G,  3  30 , 3  10,  340 , 330,  3  10 , 2  30, 3  50, 340 , 240  )  ,  I  TYPF 
C  BOX  REC  RAW  t  VI  /  V2  / 

C  /  V2  /  V3  / 

310  CALL  S6E3( I WH , AS  TER, MAS  f  ER»  FX  (  1 ) ,FX( 2) ,FX( 3) , L  BO  T , LDA  T  A , NOO , L S 1  ) 
MASTLR(LDATA)=IWH*1 IS 

CALL  SEe3I lWH, AS  TER, MASTER, FX(4) ,FX(5) ,FX(6> , LOOT , LOAT A , NOO, L S 1 ) 
MAS  f  ER ( LDA  T A )-MAS  TFR ( LOA  T  A ) ♦ I WH 

CALL  SEE3( IWH,ASTEK,NASTEK,FX( 7) ,FX( 8) ,FX( 9) , L BOT , L OA I  A , NOO, L S  1  ) 
MASTER ( LDATA* l >=IWH*I15 


GEN1 

302 

GENI 

303 

GENI 

304 

GENI 

306 

GENI 

306 

GENI 

307 

GENI 

308 

GENI 

309 

GENI 

310 

GENI 

311 

GENI 

312 

GENI 

313 

GENI 

314 

GEN! 

319 

GENI 

310 

GENI 

317 

GENI 

318 

GENI 

319 

GENI 

320 

GENI 

321 

GENI 

32? 

GENI 

323 

GENI 

324 

GENI 

329 

GENI 

326 

GENI 

327 

GENI 

328 

GENI 

329 

GENI 

3  30 

GENI 

331 

GENI 

332 

GENI 

3  33 

GENI 

334 

GENI 

335 

GENI 

336 

GENI 

337 

GENI 

338 

GENI 

3  39 

GENI 

340 

GENI 

341 

GuNl 

342 

GENI 

3  43 

GENI 

344 

GENI 

346 

GEN  I 

346 

GENI 

347 

GENI 

348 

GENI 

349 

GENI 

350 

GENI 

361 

GENI 

352 

GENI 

353 

GENI 

354 

GENI 

3  56 

GENI 

356 

GENI 

357 

GENI 

358 

GENI 

359 

GENI 

3oC 

GENI 

361 

87 


:  i 

* 

« 

'j 

CALL  SEE3UWH,ASTEK,MASTFR,FXC  10),FX< 11),FX{  12). 

GENI 

362 

1  LBOT, LDATA.NDO, LSI ) 

GEN! 

363 

MASTER  (  L  DA  T  At  l  )  =  MAST  F.R  {  L  DATAt  1  )  1 1  WH 

GENI 

364 

LDAT A=LDAT  At? 

GENI 

365 

GO  10  360 

GENI 

366 

c 

SPH  /  VI  /  R1  / 

GENI 

367 

? 

320  CALL  SEE3{ IWH.ASTFk.MASTEK.FXl 1) ,FX(2),FX(3),LB0T »LDATA»NDQ» LSI ) 

GENI 

368 

MASTER  I LUA 1 A )= IWH*  1 1 5 

GENI 

369 

LSI-1 

GENI 

370 

'■ 

CALL  SEE  3  (  IWH,ASTEK,MASTCR,FX<4)  ,FX(4) ,FX{4)  ,  LBOT  ,  LUA!  A,  NDQ,  LS  1 ) 

GENI 

371 

; 

LS 1  =  j 

GFNI 

372 

4 

X 

MASIl:R(LCATA)  =  MASTER(LOttTA)  tlWH 

GENI 

373 

LUA 1 A-LUA I  At  1 

GENI 

374 

u  r  o  360 

GENI 

375 

* 

v 

c 

RCC  FLL  /  VI  /  V2  / 

GENI 

3  76 

jv 

c 

/  /  R1  / 

GENI 

377 

. 

330  CALL  SEL  3  ( l WH, AS  T  CR, MASTER, FX( 1) »FX(2)»FX(3) .LOOT. LDATA.NDO, LSI) 

GENI 

378 

MASTER  t  LUATA )  =  lWH*l 15 

GENI 

379 

j 

* 

CALL  SEE  3 ( I WH, AS  TfcK»MAS  TER, FX ( 4 ) ,FX(5),FX(6) »LBOT, LCATA, NOQ.LS 1 ) 

GENI 

380 

■ 

l 

MASTER (LDAT A ) =M4 S T ER ( LDA T A ) t I WH 

GENI 

381 

: 

LS  1  =  1 

GENI 

382 

CALL  SEC  3( IWH, AS TER, MASTER, FX( 7) ,FX(7) ,FX(7) ,Lf3G  T  ,  LDAT  A,  NDQ,  LSI ) 

GENI 

383 

, 

lsi=:. 

GENI 

384 

MAS  TEK ( LDAT  At  1 ) = ) wM 

GENI 

385 

i 

LDAT  A  =  LDATAt? 

GENI 

386 

00  lo  360 

GENI 

387 

c 

TkC  TOR  /  VI  /  V2  / 

GENI 

388 

c 

/  «1  /  R2  / 

GENI 

389 

340  CALL  SFCiTUWH.ASTeK.MASTER.FXI  1)  ,  FX  (  2  )  ,FX(3)  ,  LBOT,  LD  AT  A  ,  NDQ,  LSI ) 

GENI 

390 

MAS  T  C  rf  (  L DA  T  A  )  =  I  WH*  1 1 5 

GENI 

391 

LALL  SEl3( IWH, AS  TER. MAS  1 ER,FX(4) ,FXJ5),FX!6) ,LBOT, LDATA, NDO.LSl ) 

GENI 

392 

MASTlR(LDATA)=MASTER(LDATA) t I WH 

GENI 

393 

L  S  1  =  1 

GENI 

394 

CALL  S  F  F  3 ( IwMfASThR»MASTER,FX( 7) , FX{ 7 ) ,F X{7 ) .LOOT , LDAT A, NDQr LS 1 ) 

GtN  I 

395 

M A  S  T  F  K ( L  DA  T A 1 1 ) = l WH*  1 1 5 

GENI 

396 

f, 

LALL  SEr.3(  IWH,  AS  TLR,  MASTER,  FX(  3)  ,FX(8),FXI8)  ,LBOT  ,  LuAT  A,  NDQ,  LSI  > 

GENI 

397 

'J 

LS  l  =0 

GENI 

398 

MASTER ( LDA  TAt 1 ) -MASTER (LDATA+l )♦ IWH 

GENI 

399 

LDATA=L0ATAt2 

GENI 

400 

r 

00  TO  360 

GENI 

401 

« 

c 

TEC  /  VI  /  V2  / 

GENI 

402 

c 

/  V3  /  V4  / 

GENI 

403 

>;■ 

; 

c 

/  R1  /  R2  / 

GENI 

404 

v 

c 

/  /  K3  / 

GENI 

405 

350  CALL  SFE3( I WH , AS  TER, MAS  TER, FX < 1) , FX < 2 ) ,FX { 3 )  , LBOT , LDAT A, NDQ, LS 1 ) 

GENI 

406 

3 

MASTcR(L0ATA)=IwH*115 

GENI 

407 

- 

? 

CALL  SEE  3  ( IWH, AS  TER, M ASTER, FX(4) ,FX(5) ,FX(6) , LBOT , LDAT A, NDQ, LSI ) 

GENI 

408 

KASTtR(LDATA)=MASTLR(LDATA)tIWH 

GENI 

409 

CALL  SEE  3 (IWH, AS  TER, MAST ER , FX { 7 ) , FX { 8 ) , F X ( 9 ) , LBOT, LDAT A , NDQ, LS 1 ) 

GfcNI 

410 

1 

MASTEK(LDATAtl)=IWH*ll5 

GENI 

411 

;< 

CALL  SEE3I IWH.AS  TER, MASTER, FX ( 10 ) , FX ( 1 1 ) , FX { 12 ) , 

GLNI 

412 

■ 

l  LBOI .LDATA.NDO, LSI ) 

GENI 

413 

V 

MAS TEK (LDAT At  1 )  =  MASTER ( LDAT At 1 )t IWH 

GENI 

414 

, 

f 

LS  1=  l 

GENI 

415 

CALL  SEE31 IWH, ASTER.MASTER.FXC 13),FX( 13) ,FX( 13), 

GENI 

416 

1  LBC T, LDATA.NDO, LSI ) 

GENI 

417 

MAS  f  ER (  L0ATAt2 )= IWH*  I 15 

GENI 

418 

r 

CALL  SEt  3 ( I WH , AS  TER, MASTER, FXI 14 ) , FX ( 14 ) , FX ( 14 ) , 

GENI 

419 

* 

1  LBCT, LDATA.NDO, LSI) 

GENI 

420 

MASTER(L0ATAt2)=MASTER(LDATAt2)+IWH 

GENI 

421 

J 

a 

a 

88 

j 

\ 

i 

'j 

non  onoo  noon  no  o  non 


360 


370 


375 


390 


CALL  SEE3( I WH, ASTER, MASTER, FX( 15 ) ,FX ( 15 ) , FXC 15 ) , 

1  LB0I»LDATA,NDQ»LS1 ) 

LS  1=0 

MAST£ft(L0ATA+3)=IWH 

LUATA=L0ATA+4 

CHECK  IF  ANY  MORE  ROOM  FOR  SOLID  DATA 
1HL0ATA.LT. N0QJG0T0  370 
WKtTF  (6,917) L0A TA,L 80 T,N0Q 
STOP 

CONTINUE 
WRITE  (6,918) 

WR i I E ( 6 , 94  7)1 TY.NBOO 

WRI  ft  (6»945)LBASE»LRPP0»LABUT ,L  BODY ,LBOD»LDATA,LBOT,LSCALi 
ADO 

IRANSFER  ASTER(Lb()T  -  NDO )  TO  ASTER(LDATA  -  LOATA+LSUB) 


L0=L()ATA-1 

LSUft  =  LBU  T-LIj-1 

00  JC5  I  =LB0T , NOG 

ASTfiR(LOAIA)=ASTFR{l) 

lda  t  A=LOATA+ 1 

CONTINUE 

UNPACK  POINTERS  AND 
K=LB0DY+3*(NRPP+NB00Y) 
00  390  I =  K , L 0 
CALL  UN2 (1,11,12) 
IF(Il.NE.O)ll=Il-LSUB 
I F (  12.NE.0)  12= I2-L  SUB 
MASTER! I  )  =  I 1*1 15+12 
CONT (NUE 


ADJUST  FOR  TRANSFER 


400 


410 


REGION  STORAGE. 

LRFGD  /  LOC  BODY  LIST  /  NUM  OF  BODIES  / 

LOATA  /  CPtRATOR  /  BODY  NUM  / 


WRITE  (6,920) 

N=0 

J=0 

lregd=ldata 

LDA  T  A=LUAT  A+NRMAX 
LREGL=LDATA 

READ  REGION 

READ! 5,921 ) I R , ( I  A ( I ) , I N( I ) , 1  =  1 ,9 ) 
CHECK  VALIDITY  OF  REGION  DATA 
DO  410  1=1,9 

I  F  {  I  ABS  (  1N(  D)  .LF.NBOOY  +  NRPPJGOTO  410 
WRITE  (6,922) I R, I 
J  =  J+1 
CONTINUE 

STORE  region  data 


IF (  1R ) 440,420,42 l 

420  WRITE  (6,923)  (  IA.(  I  ),  INI  I  >,1=1,9) 
GOTO  430 

421  N=N+1 


GE'NI 

422 

GENI 

423 

GENI 

424 

GENI 

425 

GENI 

426 

GENI 

427 

GENI 

428 

GENI 

429 

GENI 

4  30 

GENI 

431 

GENI 

432 

GENI 

433 

NGENI 

434 

GENI 

435 

GENI 

436 

GENI 

437 

GENI 

43B 

GENI 

439 

GENI 

440 

GENI 

441 

GENI 

442 

GENI 

443 

GENI 

444 

GENI 

445 

GENI 

446 

GENI 

447 

GENI 

448 

GENI 

449 

GENI 

450 

GENI 

451 

GENI 

452 

GENI 

453 

GENI 

454 

GENI 

455 

GENI 

456 

GENI 

457 

GENI 

458 

GENI 

459 

GENI 

460 

GENI 

461 

GENI 

462 

GENI 

463 

GENI 

464 

GENI 

465 

GENI 

466 

GENI 

467 

GENI 

460 

GENI 

469 

GENI 

4  70 

GENI 

471 

GENI 

472 

GENI 

473 

GENI 

474 

GENI 

475 

GENI 

476 

GENI 

477 

GENI 

478 

GENI 

479 

GENI 

480 

GENI 

481 

89 


o  o  o n  nor 


WRI  Ft  (6,924)  IR,  (  IAU),  INU),  1  =  1,9) 

M=LKFG0+N-1 

MAS  TfcR(  M  )  =LfMTA*  I 15 

C  LHElK  operator 

430  00  435  1=1,9 
IJO  431  K=  l ,  8 

IF ( IA( I).fcO.IAA(K) )G0T0  432 

431  CONTIMUt 

WRITE  ( 6 ,923  )  I A { 1 ) , ! 

STOP 

432  U(H  =  IA\‘{K) 

IF( INC  I ) 1433,400,434 

433  I  A (  1 ) =4+ I A { I ) 

IN ( 1 )=-lN(I) 

434  MASTF!<(LDATA)  =  IA(  I  )*!15+IN(  1  ) 
LOATA=LL>ATA+l 

MASTFk (M)= MASTER (M)  + l 


GfcNI  482 
GENI  483 
GfcNI  484 
GENI  485 
GfcNI  486 
GENI  487 
GENI  488 
GENI  489 
GENI  490 
GENI  491 
GENI  492 
GfcNI  493 
GfcNI  494 
GENI  495 
GENI  496 
GfcNI  497 
GfcNI  498 


oooooooo 


CALL  UN2(KLK, IOPO»NBO) 

00  45 2  Kl=l,ll 

KLK-LOCJtKl-1 

CALL  UN2(KLK,I0Pl,NBl) 

IFI 10P0.NE. I0PIJG0T0  452 
IHNIJO  . NE.NB  l  )  GOTO  452 
KIS=MIS*1  . 

GOTO  453 

452  CONTINUE 

453  CONTINUE 
IF(MIS*NE.I I 1G0T0  454 
WRITS  ( 6  *929 ) J  » I 
LL=LL+I 

454  MI S=0 

455  CONTINUE 
WRITE  (6,930)1 

456  CON T I NUt 

I F ( LL . G  T .0 ) STOP 
WkIIE  (6,937) 

IS  =  M  ENTERING  TABLE  STOREO  BY  115 

WHICH  REGIONS  (J)  A  RAY  MIGHT  BE  IN  IF  IT 
ENTERS  A  GIVEN  BODY  ( I ) 

IS=-l  LEAVING  TABLE  STORED  BY  l 

WHICH  REGIONS  (J)  A  RAY  MIGHT  GO  INTO  IF  IT 
LcAVES  A  GIVEN  BODY  ( I ) 


C 


500  IS=~1 

NN=NBuDY  +NRPP 
LENLV=LD4TA 
00  d90  MMM= 1 , 2 
UO  560  1=1, NN 
M=LBODY+ 3* ( I- I ) 

IFI IS.GE.O)oO  TO  510 

MASTER  I M+l )=MASTER(fm)*LOATA 

GO  10  520 

510  MASIFRIM+1)=MASTER(M  +  1  )+LCAI  A*  U5 


520  UO  570  J= 1 , NRMAX 
l TEMP=LRFGD+J-1 
CALL  UN2 ( 1  TEMP ,LOC ,NC ) 

CALL  UN2 ( LOC , I  OP , DUM ) 

00  560  N= 1 , NC 
MM*U«CM|-1 

CALL  UN2 (MM, 10PEK,NUM» 

IFtNUM.NE.  IJGOTO  560 
I F ( 10P.E0.1.0K.I0P.EQ.5IG0T0  540 
IF ( 1OPER.GT.4JG0T0  530 
1F( IS-11560,550,560 

530  1F( 15*1)5 60, 551, 560 

540  IF ( IS. LI . 0 ) GOTO  551 

550  MASTER ( M+2 ) =MAST ER ( M+2 ) ♦ 1 15 
GO  10  552 

551  MASTER(M+2)=M,ASTFR(M  +  2)  +  l 

552  MASTER(LOATA)=J 
L0ATA  =  LI)ATA+1 
IF(LOATA.LT.NOQ)GOrO  570 
WRITE  I  6,931 )  LDA-TA,NDQ*MMM,  1 
STOP 

560  CONTINUE 


GENI 

542 

GENI 

543 

GENI 

5^4 

GENI 

545' 

GENI 

546 

GENI 

547 

GENI 

548 

GENI 

549 

GENI 

550 

GENI 

551 

GENI 

552 

GENI 

553 

GENI 

5  54 

GENI 

556 

GENI 

356 

GENI 

557 

GENI 

558 

GENI 

559 

GENI 

560 

GENI 

561 

GcN  I 

562 

GfcNI 

56  3 

GLNI 

564 

GENI 

565 

GLNI 

56* 

gl-ni 

567 

GENI 

566 

GENI 

569 

GENI 

570 

GfcNI 

371 

GLNI 

572 

GLNI 

573 

GfcNI 

574 

GlM 

57*' 

GENI 

576 

GENI 

577 

GENI 

57  ft 

GEN  l 

579 

GENI 

580 

GfcNI 

GENI 

582 

GENI 

58  i 

GENI 

584 

GENI 

585 

GENI 

586 

GENI 

587 

GENI 

58P 

GENI 

Sflw 

GENI 

590 

GENI 

591 

GENI 

592 

GENI 

593 

GENI 

594 

GENI 

6V‘> 

GENI 

596 

GENI 

597 

GENI 

698 

GENI 

5  9  9 

GENI 

600 

GENI 

601 

91 


OOOO  OOJO  o 


570  CONTINUE 
580  CONTINUE 

write  i6,93ajMMM 
!S=lS+2 
590  CONTINUE 

C  KIN  STOKAGE  KOUT  STOKAGE  Gl  TEMP  STORAGE 

Ll=Ll)ATA-i 
NN=NRPP  tfJHODY 
LK IN=L0ATA+1 
LROT=LRl N+NN 
LlO=LKOT*NN 
LEGE0M=L lOfrNN 
KKlTf  (6,932  )  LEGEOM 

WRITE  (0,919)LRCGO,LREGL,LENLV,LRIN,LROT,LIO,LEGEOM 

PRINT  ENTERING  AND  LEAVING  I  ABLE 

IE (IfNTLV.EC.NC) return 
WRJ TE (6,946) 

NBNR=NBuDY*NRPP 

DO  60a  •  )=  l  ,  N81NR 
L0C  =  li)0(m3*(N-l  ) 

LOC  =  L  9C ♦  1 

CALL  llN2  (  LuC ,  L  EN  T»  LE  AV  ) 

LOC=LOC* l 

CALL  UN2 (LOC ,NENT ,NEAV ) 

J  l  =  L  f:  N  T 

J2  =LFNT  +  UEN  T- 1 

WKl 1L  (6,9  13  IN, J1,J?,(MASTEK(K) ,K=J1,J2) 

Jl=UAV 

J2-LEAV+NEAV-1 

WRIT):  (6,934)N,J1,  J2  ,  ( MAS TEK( K > , K* J 1 ,  J2) 

600  CONUNUL 

MASIFR-ASTER  ARRAY  1UTPUT 

IF( IPRIN.LO.OIRETUKN 
WKKF  (6,935) 

DO  620  K-LBASE ,L 1 , 3 
I  K  =  R 
IK2=K*2 
M.=0 

00  610  I=IK,IK2 
M=M*  1 

CALL  UN2 (1,11,12) 

NO  1 ( M )  =  1  1 
N02 ( M )  =  I  2 
04  (  M)  =  AS  TER  (  I  I 
NOO (  M  )  =  1 
610  CONTINUE 

WRI Tfc  (6,936) (NOO(L) ,N01 (L) ,N02 < L ) ,041 L > , L* l , 3 > 

620  CONTINUE 
RETURN 
END 


SUBROUTINE  RPPIN(LAR) 

OIMCNSION  MA S I ER ( 30000 ) , X (6 )  92 


GENI 

602 

GENI 

603 

GENI 

604 

GENI 

605 

GENI 

606 

GENI 

607 

GENI 

608 

GENI 

609 

GENI 

610 

GENI 

611 

GENI 

612 

GENI 

613 

GENI 

614 

GENI 

615 

GENI 

616 

GENI 

617 

GENI 

618 

GENI 

619 

GcN  l 

620 

GENI 

621 

GENI 

622 

GENI 

623 

GENI 

624 

GENI 

625 

GENI 

626 

GENI 

627 

GENI 

628 

GENI 

629 

GENI 

630 

GENI 

631 

GENI 

632 

GENI 

633 

GENI 

634 

GENI 

635 

GENI 

636 

GENI 

637 

GENI 

638 

GENI 

639 

GENI 

640 

GENI 

641 

GENI 

642 

GENI 

643 

GENI 

644 

GENI 

645 

GENI 

646 

GENI 

647 

GENI 

648 

GENI 

649 

GENI 

650 

GENI 

651 

GENI 

652 

GENI 

653 

GENI 

654 

GENI 

655 

GENI 

656 

GENI 

657 

GENI 

658 

GENI 

659 

**** 

15 

RPPIN  2 

COMMON  A.S  TER (  30000  1 

RPP  IN 

3 

COMMON/GEOM/LBASE,RlN,ROUT,LRI ,LR0,P1NF » IERR.DIST 

RPP1N 

4 

COMMON/UNCGEM/NRPP,NTRIP,NSCAL,NBODY,NRMAX,LTR!P,LSCAL,LREGD, 

RPP  I  N 

5 

1 

LDAIA,LRIN,LR0T,II0»L0CDA» 115, 130, L BODY, NASC,KL00P 

RPP  IN 

6 

C0MM0N/KRPP/LRPPD,LA8UT 

RPP  IN 

7 

EQUIVALENCE (MASTER, ASTER) 

RPP  I N 

0 

c 

RPPIN 

9 

910 

EORMAT (6F12.6) 

RPP  I N 

10 

920 

FORMA T( 18,1?X,6F12.5) 

RPPIN 

11 

930 

FORMAT! 1H0,27H£RR0R  IN  DESCRIPTION  OF  RPP , I 5 , 5X , 10HM IN. GE, MAX ) 

RPPIN 

12 

940 

FORMAT! IH0.27HERR0R  IN  DESCRIPTION  OF  RPP,7X, I 10, 10X, i 10) 

RPPIN 

13 

950 

FORMAT! 1  OX, 7HSUR FACE, 15,8 X,2E20. 6) 

RPPIN 

14 

c 

RPPIN 

15 

c 

N  IS  RPP  NUM8ER  J  IS  SURFACE  NUMBER 

RPPIN 

16 

c 

RPPIN 

17 

c 

mastfr-aster  STORAGE  FOR  RPP 

RPPIN 

18 

c 

RPPIN 

19 

c 

LBASE  -  RPP  PO IN  I ERS  RESERVE  12  WORDS/RPP 

RPPIN 

20 

c 

/  1  /  J  / 

RPPIN 

21 

c 

/  /  K  / 

RPPIN 

22 

c 

I  (POINTER  TO  LIST  OF  ABUTING  RPP'S) 

RPPIN 

23 

L 

J  (NUM  Of  RPP'S  THAT  ABUT  THIS  SURFACE) 

RPPIN 

24 

c 

K  (POINTER  TO  MIN  OR  MAX  CORRESPONDING 

RPPIN 

25 

c 

TO  THIS  SURFACE) 

RPPIN 

26 

c 

RPPIN 

27 

G 

LRPPO  -  RPP  DATA  STARTING  AT  LBASE  +  12  *  NRPP 

RPPIN 

28 

c 

MIN  OR  MAX  K  POINTS  HERE 

RPPIN 

29 

c 

RPPIN 

3C 

G 

LABUT  TO  LBODY-1 

RPPIN 

31 

c 

LIST  OF  ABUTING  RPP'S  PACKED  l  OR  2/WORD 

RPPIN 

32 

c 

1  POINTS  HERE  11/2/ 

RPPIN 

33 

c 

J  CONTAINS  NUMBER  IN  LIST 

RPPIN 

34 

c 

RPPIN 

35 

I  tRR  =  0 

RPPIN 

36 

N=  1 

RPPIN 

37 

I  =  l.BASE  +  12+NRPP 

RPPIN 

38 

LkPf’D-l 

RPPIN 

39 

10 

READ! 5,910) (X(J) ,J=1,6) 

RPPIN 

40 

WRITE  (o,92G)N, 1 X ( J),J=1,6) 

RPPIN 

41 

DO  20  J-  1 ,6,2 

RPPIN 

4? 

IF(X(J).LT.X{ J+l ) (GOTO  20 

RPPIN 

4  i 

WRITE  ( 6 , 9  3  0 ) N 

RPPIN 

44 

STOP 

RPP  >N 

45 

20 

CONTINUE 

RPPIN 

46 

c 

RPPIN 

47 

L 

STORE  MIN  AND  MAX  BEGINNING  AT  LBASE  ♦  12  *  NRPP 

RPPIN 

48 

c 

RPPIN 

49 

DO  33  J= l , 6 

RPPIN 

50 

I  l  =  LBASfc  +  12*NRPP 

RPPIN 

51 

L=LBASE+ 12* ! N-l) +2*1 J-l ) 

RPPIN 

52 

30 

IF!  I  I.LT.  DGOTO  31 

RPPIN 

53 

ASTER! I )=X( J) 

RPPIN 

54 

MASTER(L+1)=I 

RPPIN 

55 

1  =  1  +  1 

RPPIN 

56 

GOTO  33 

RPPIN 

57 

c 

CHECK  FOR  DUPLICATION 

RPPIN 

58 

31 

IF(X(J).EO.ASTER(II) JGOTO  32 

RPPIN 

59 

11=11+1 

RPPIN 

60 

GOTO  30 

RPPIN 

61 

32 

MASTEK!L  +  l)  =  I  I  93 

RPPIN 

62 

o  o  o  rs  f~.  n  o 


33  CONTINUE 

IMN.uE. NRPP  1G0T0  40 
N=N*  1 
GOTO  10 

40  LABIUM 
LASTM-l 
L  =  L  AS  r 

SEARCH  FOR  AOUTING  KPP*S  TO  SURFACE 

DO  57  1  =  1  ,NRPP 
00  57  N=  1 , 6 

Ll  =  0 
M=1 

K=L0ASE+12*< 1 -  1 ) +  2MN-1 ) 

MAS  TER  IK  >  =  (  L  ♦  1)*115*MA$IER(K) 
NC=3«N-L-4*(N/?> 

00  56  J=1,NKPP 

I  F (  l.FQ.JlGUlO  56 

1 F  (  S  (  l » ‘I )  .NF  .  S  { J  *  NC  )  )  GOTO  5b 

DO  63  K=lr3 
MN  =  N«-i:C 
K41=4*K- 1 

I  F I NN. F0.K4 l ) GOTO  53 
K?  =  2*K. 

K2 1  =  K  2-  1 

I F  (  S  (  I » K  2 1 ).GT.S(J,K21 ) ) GOT  0  50 
IF(S(J,K21 ).IT.S(I,K2  DGOTO  53 

50  IF  (S<  I  ,K.21).GL.S  {  J,K2  DGOTO  51 
IF(S(J,n2  ).LL.S(I,K2  DGOTO  53 

51  IF  (  S(  1  »K2  ).GT.S(J,K2  DGOTO  56 
IF(S(I,K21 ).LT.S(J,K2l))G0T0  56 

53  CONTINUE 
M  =  -M 

IFIM.LT.OIGOTU  54 
MASTERd  l-MASTGR  CLDJ 
GOTO  55 

54  L  =  L+  1 
MASTER!!.  )-J*I  15 

55  ll=LL+l 

56  CONTINUE 

K  =  LBA SE+ 1 2*  ( I - l ) +2*(N-1) 

MASTER  IK  )=MASTE*<K  Dll 

57  CONTINUE 

TEST  VAL IDI TY  OF  RPP  DATA 

IFINRPP. IE. DGOTO  63 

DO  62  J  =  1 » 6 
NRPP  1  =NRPP-'l 
00  61  I  =  1 » NRPP 1 
JJ=LBASE  +  12*1 1-1 D2MJ-1) 

CALL  UN2 (JJ, I0UM.I2) 

I3=MASTER(  JJ+D 
I F ( I2.NE.01G0T0  fel 

II  =  D1  q4 

00  60  K= l l, NRPP 


RPP IN  63 
RPPIN  64 
RPP I N  65 
RPPIN  66 
RPPIN  67 
RPPIN  68 
RPPIN  69 
RPPIN  70 
RPPIN  71 
RPPIN  72 
RPPIN  73 
RPPIN  7 4 
RPPIN  75 
RPPIN  76 
RPPIN  77 
RPPIN  78 
RPPIN  79 
RPPIN  00 
RPPIN  81 
RPPIN  82 
RPPIN  03 
RPPIN  04 
RPPIN  85 
RPPIN  86 
RPPIN  87 
RPPIN  88 
RPPIN  89 
RPPIN  90 
RPPIN  91 
RPPIN  92 
RPPIN  93 
RPPIN  94 
RPPIN  95 
RPPIN  96 
RPPIN  97 
RPPIN  98 
RPPIN  99 
RPPIN100 
RPPIN101 
RPPIN102 
RPPIN103 
RPP I N l 04 
RPP I N 105 
RPP IN  106 
RPPIN107 
RPP I N 108 
RPP I N 109 
RPP I N 1 10 
RPPINlll 
RPP INI  12 
RPP I Nl 13 
RPP IN 1 14 
RPP INI  15 
RPP I Nl 16 
RPPIN117 
RPP I Nl 18 
RPPIN119 
RPPIN120 
RPPIN121 
RPPIN122 


I 


NK=l.BASEN2*(K-l  )+2*(  J-l  ) 

CALL  UN2(KK, ICUM.15) 

16  =  MASTER(KK«-1 ) 

I  F (  15.NE.01G0I0  60 
IF C  I3.E0.I6)G0T0  60 
IERR= I  ERR* 1 
WRITE  (  6  *940  >  !  »K 

WKI TF  (6  ,950 )  J,ASTERl  I  3),  AS  TER (16) 

CONTI ''Hit 

GOTO  6? 

continue 

continue 

LAR=L 
RC  T  URN 

END  1 


SUBROUTINE  ALBER T { FX , LBOT  ,NOQ, LS 1) 

0 1  MENS  ION  MASTER  (  30000  )  *  IA(6,4'),AA(8!,3),F(4)  ,  EX  (  6  )  ; 

COMMON  ASTER (30000)  .  .  1 

COMMON /UNCGE  M/NR  PP  ,N  TK  I P  »  NS CAL  , NBODY  »NRMAX*{  TRIP,LSCAL,LREGD, 
L  Ll>A  I  A«  LR  I  N»  LRO  T,  L I  0,  LOCCA  ,  l.l  5*  I  30,  LBODY  ,NASC » KLOOP  , 

COMMON/OfTCM/LbASE, KIN, ROUT, LRl ,LRO. P INF , I  ERR ,D I  ST 
EOUIVALL-NCEI ASTER, MASTER)  ,  '  . 

i 

FORMAT (25X.6F12. 5) 

!  FORMAT! I0X,6( IX, All) )  .  .  1 

l  FORMAN  I0X.6E10.  3)  1 

>  F0RMAT(25X,614X,4I2) ) 

>  FORMAT  ( IUO,  15MUN0EFINE0  PLANE).  I 

>  FORMAT! IS, 10(fcli .A))  • 

'  FORMAN  1H0,26HF0UR  POINTS  NOT  IN  A  PLANE)  ‘  .  , 

I  FORMAT ( 1H0, 25HERR0R  IN  SIDE  DESCRIPTION)  , 

I  FORMAN  1H0, 16H0EGENERATE  PLANE,  15) 

t  i 

K=1 

00  10  1=1,2  1  j  '  I 

DO  10  J=l,3  ,  ■ 

AA( I ,J)=FX(K) 

K=K+1  ! 

)  CONTINUE  .  .... 

READ! 5,903)1 ( A  A ( I »J) ,J=I,3) ,1  =  3,8)  ,  *  ' 

ROAO(5,9C2)  (  (  IA(  I,  J»,J  =  1’,4)  ,1=1,6) 

WRITE  (6,901 )  (( AA( I , J ) , J  =  1 , 3 ) , I >3 , 8 )  •  , 

WRITE  (6,904) (( IA!l,J),J=l,4),I-l,6) 

00  70  1=1,6 

1 X= 1  A (  I  ,  1  )  :  ’ 

I Y= 1 A ( I , 2  ) 

I Z= I A ( I , 3 )  .  ;  1 

X 1  -  AA  l  I  X  ,  1  ) 

Yl-AA (  I X ,2  )  '  ! 

Z 1  =  A  A (  IX,  3)  ,  * 

X2  =  AA ( I Y  ,  1)  ! 

Y2  =  AA ( I Y , 2 )  }  , 

Z2  =  AA ( I Y , 3  )  T  '  • 

X3  =  AA (  I  Z  ,  1  )  l  :  ■ 

Y3  =  AA I  I  Z  ,  2  )  ,  ;  • 

Z3= AA ( I Z , 3 )  ■  '  :  :  i  = 

l)=Xl*(  Y2*Z3-Z2*Y3)-X2*(Y1*Z3-Z1*Y3)  +  X3*(  Yl*Z2-Zl*Y2) 


RPPIN123 
.  RPP\N12  , 
RPP1N125 
RPPI.N126 
RPP IN l 27 ■ 

;R  P  P  I N 1 2  0 
RPPIN129 
RPP I N 1 30 
RPP I N 1 3  1 
RPP I N l 32 
1  RPP  IN  1,3 3 
RPP IN  134 
RPPIN13S. 
I^PP  IN  1  36 
RPP IN  137  ' 
RPPINL38 
RPP (N l 39 
1 ,  16 
ALBERI  2 
ALBERT  3 
ALBERT  4 
ALBERT  '5 
ALBERT  6 
■  ALBERT  7 
ALBERT ' 8 
ALBERT  9 
ALBERT  1C 
ALBERI  1 1 
'ALBERT  12. 
ALBERI  1'3‘ 
ALBERI  14 
I  ALBER  T 1 5 
ALBER  T 1 6 
ALBER  T  l  7 
‘  AL'BLR  I  18 
ALBER  T 19 
ALBER  T 20 
AL8ERT21  1 
ALBb'RI  22 
ALBER  T  23 
ALBERT24  . 
ALBERT  25 
ALBERT  26 
ALSERT27 
ALBER  1 28  ' 
ALBERI 29 
ALBERpO  1 
ALBERT31 
ALBERT32 
ALBER  T33 
ALBER  T3‘4 
ALBER  T  35 
ALBERI 36 
ALBER  T3'7, 
ALBERT38" 
albert 39 
ALBER T 40  . 
ALBER  T4  1 
ALBERT  42 
ALBERT43 


I 


J 


I 


o  r 


A=(-Y2*Z3+Z2*Y3*Y1*Z3~Z1*Y3-YI*Z2+Z1*Y2) 

Albert  44 

b=  (  X2*Z  i-Z2*X3-Xl*Z3  +  X3*Z  1  +  X 1 *Z2-Z  1*X2 ) 

ALBERT45 

C=( Y2*X  )-X2*Y3-Yl*X3+Xl*Y3+Yl*X2-Xl*Y2 1 

ALBERT46 

012= I  X l- XJ ) **2* ( Y1-Y3) **2  +  t  Z1-Z3 ) **2 

ALBERT47 

A2f)2C2  =  A*A*B*B<-C*C 

ALBERT  48 

l H  A2B2C 2.NE .C . ) GOTO  21 

ALBERT49 

WRIIt.  (6,009)1 

ALBERT50 

0  =  Arts  C  D ) 

ALBEKT51 

GO  FU  61 

ALBERT52 

21 

01210»012*1.0E-12 

ALBERT53 

lF(A2l>2C2.GT.  01210)  GOTO  22 

ALBERT54 

WRITE  (6,905) 

ALBERT55 

WRIT?  (6,906) !, A, 0,C, 0,012 

ALBLRT56 

IERK= lEKK+l 

ALB&RT57 

GOTO  70 

ALBERT58 

22 

S=SORF (A2B2C2) 

ALBERT59 

wX=A/S 

ALBERT60 

WY=B/S 

ALBER  f  61 

wZ=C/S 

ALGER T  62 

1 C  =  1  A  (  [  ,  4  ) 

ALBERT63 

X4= AA ( IC, l ) 

ALBER  T 64 

Y4= AA ( I C , 2 ) 

ALBERT65 

Z  4  =  A  A  ( IC,3) 

ALBER  T  66 

02=  (-0-1  A*X4)-(B*Y4)-(C*Z4)  )/(  (  A *WX )  *■  (  B*WY )  +  ( C*WZ  )  ) 

ALBER  T 67 

022=02*02 

ALBERT68 

THE  NEXT  CAR  15  BYPASSES  THE  4 TH  POINT  TEST 

ALBER 169 

IF  ( 022. CF. 0.01) GOTO  30  3  PRINT  907  t  IERR=IERR<-1 

ALBERT70 

I F ( 02  2 . L  C . 1.01 (GOTO  30 

ALBER I  71 

WRIIE  (6,907) 

ALBERT72 

IERR= I ERR+ l 

ALBERT73 

WRITE  (6,906) I , A, B,C, 0,012, 02 

ALBER  T  74 

GOTO  70 

ALBER  T75 
ALBERT76 

30 

DO  31  K=  1,4 

ALBER  T  77 

F  (  K  )  =0. 

ALBER  T78 

31 

CONTINUE 

ALBERT79 

L  =  l 

ALBERT80 

DO  32  J  —  1 , 8 

ALBER  T8 1 

IF  (  J.EQ.  IX.OR.J.EQ.IY.OR.  J.EO.IZ.OR.  J.EQ.IOGOTO  32 

ALBERT82 

F(L ) =A*AA( J, 1 )+B*AA( J,2)+C*AA(  J,3>+0 

ALBERT83 

L  =  L  +  1 

ALBERT84 

32 

CONTINUL 

ALBERTB5 

M=0 

ALBERT86 

N=0 

ALBERT  87 

J  =  0 

ALBERT  88 
ALBERT89 

O 

o 

r~ 

n 

ALBERT90 

IF( ABS(F (L)  ).LE. 1.0E-6)G0T0  42 

ALBERT91 

IF(F(L  )  >41,42,43 

ALBERT92 

41 

M=M+1 

ALBERT93 

GOTO  44 

ALBER  T  94 

42 

N=N*1 

ALBERT95 

GOTO  44 

ALBERT96 

43 

J  =  J+l 

ALBER  T  97 

44 

CONTINUc 

ALBER  T  98 
ALBERT99 

I F ( N. fcQ. 0) GOTO  51 

ALBER 100 

I  F ( H  +  N. HO. 4 ) GOTO • 60 

ALBER101 

IF  (J<-N.EQ.4)G0T0  61 

ALBER102 

GOTO  52  96 

ALBER103 

O  O  O  O  O  Cl  o 


51  IF ( M«  EQ.4 ) GOTO  60 
IF  t  J.EU.4)G0TC  61 

52  WRITE  (6,908) 

j  6  ^I,^,8,c,D,D12,02f(F(L)fL*l,4) 

GOTO  70 

60  A=-A 
8=-B 

c=-c 

LS 1=  1 

CAUSHJUHH.ASrER,  MASTER,  0,0, 0  ,  LBOT,  LDATA,  NDQ,  LSI ) 

MASTER(LDATA)=MASTER{L0ATA)+IWH*I15 
LDATA=LDATA+1 
70  CONTINUE 
RETURN 
END 

SUBROUTINE  AR INC LBOT , LOATA, MASTER , ASTER . I WH> 

»N  MASTER  1 30000 )» ASTER) 30000)  E* 

COMMON/UNCLE/NN, IC(4) 

SEE  ARS  SUBROUTINE  FOR  STORAGE  IN  MASTER-ASTER  ARRAY 

901  FORMAT ( 10X,2I 10) 

902  FORMAT (10X,6£10.3) 

903  FORMA  I  (  1 8,  1 X  ,  3A1 ,  2X»  3HAR  S,  2X»  A4,  6X  » 19HNUMBER  OF  fliax/F*;  tc 

«.'f0R  pows  per  ,s’'6' 

MAX  =  NUM  OF  CURVES 
NAX  =  NUM  OF  FOI NTS/ CURVE 

REAO( 5, 901 ) MAX ,N AX 

^;903)NN,(IC(I/,I  =  lf4)fMAXfNAX 
LB0T=l_B0T-4*MAX*NAX-92 
I WH=LB0T 

MASTER(LOATA)=IWH 

L0ATA=LDATA+1 

DO  50  M= 1 , MAX 
Ll*LB0T+92+4*NAX* ( M- 1 ) 

L2=L1+4*NAX-1 

y«^5;!0!^fSr£R(U’ASTER<L  +  l,»ASTER(^2),L=Ll,L2,A) 

WRITE  ((66;990°:!(ASTE  R(L,*AST^‘^l^ASTHR(LF2),“ua2!A, 

50  CONTINUE 

MASTfcR(LB0T)*0 

MASTER(LB0T+1)=MAX 

MASTER(LB0T+2)=NAX 

RETURN 

ENU 


SUBROUTINE  SEE3I IWH, ASTER, MASTER, FX.FXX.FXXX, LBOT, LOATA. NDQ.LS 


ALBER104 

ALBER105 

AEBER106 

ALBER107 

ALBERI08 

AEBER109 

ALBER110 

ALBER1 11 

ALBER112 

ALBER113 

ALBER114 

ALBER115 

ALBER116 

ALBER1 17 

ALBERU8 

AEBER119 

ALBER120 

AL8ER121 

ALBER122 

ALBER123 

ALBER124 

ALBER125 

ALBER126 


**** 

17 

ARIN 

2 

ARIN 

3 

ARIN 

4 

ARIN 

5 

ARIN 

6 

ARIN 

7 

ARIN 

8 

ARIN 

9 

ARIN 

10 

ARIN 

11 

ARIN 

12 

ARIN 

13 

ARIN 

14 

ARIN 

15 

ARIN 

16 

ARIN 

17 

ARIN 

18 

ARIN 

19 

ARIN 

20 

ARIN 

21 

ARIN 

22 

ARIN 

23 

ARIN 

24 

ARIN 

25 

ARIN 

26 

ARIN 

27 

ARIN 

28 

ARIN 

29 

ARIN 

30 

ARIN 

31 

ARIN 

32 

ARIN 

33 

ARIN 

34 

ARIN 

35 

ARIN 

36 

**** 

18 

97 


DIMENSION  AS  THK { 30000J .MASTER!  30000} 

SEE3 

2 

c 

. 

SEE3 

3 

c 

STORES  TRIPLEIS  AND  SCALARS  IN 

MASTER-ASTER  ARRAY 

SEE3 

4 

c 

SEES 

5 

IfILSl.NL.0)G0r0  50 

S6E3 

6 

c 

TRIPLETS 

SEE'3 

f 

if ( i.nor.Gr.Noo)oorc  20 

SUE  3 

8 

NOQ2=MOU-2 

SEE3 

9 

00  10  I=LB0T,ND02 

SEE3 

10 

!P{ASTE.<(  1  ).NE.FX)G0T0  10 

SEE3 

11 

IF { AS  1 ERI i +1 } .NE.PXX )G0f 0  10 

SEE  3 

12 

IF(A$JFk(H-2).NE.FXXX)GoT0  10 

SEE3 

13 

IWHM 

SEE3 

14 

HE  TURN 

SEE3 

15 

10 

CONTINUe 

SEE'3 

16 

20 

ASTER  (LtlOT-l)=FXXX 

SEE3 

17 

ASTtR(Lii0r-2)  =  FXX 

SEE3 

18 

ASTFRILl30r-3)=FX 

SEE3 

19 

LH0T=LBDT-3 

SEE3 

20 

iwh=ldot 

SEE3 

21 

IF(L80T.LE.L0ATA )WKI T6  (6,301  LOOT, 

LDATA 

SEE3 

22 

RETURN 

S6E3 

23 

30 

FORMAT { 1H0, 22HMEM0RY  OVCRLAP  IN  SEE3,5X, 5HL80T=, I 10, 

SEE3 

24 

l  5X,6HLDA f A=, 110) 

SEE3 

25 

c 

SEE3 

26 

c 

scalars 

SEE3 

27 

50 

UO  60  l=L80T,N0Q 

SEE3 

28 

I F ( AS  I ER  C I ) .NE.FXJG9T0  60 

SEE3 

29 

IWH=I 

SEE3 

30 

RETURN 

SEF3 

31 

60 

CONTINUE 

SEE3 

32 

ASTER 1L BO T-1)=FX 

SEE3 

33 

LU0T=LB0T-1 

SEE3 

34 

IWH=LHO 1 

SEE3 

35 

RETURN 

SEE  3 

36 

END 

SEE3 

37 

c 

SEE3 

38 

c 

SEE3 

39 

FUNCTION  SI  I , m 

**** 

19 

DIMENSION  MASTER (30000) 

S 

2 

COMMON  ASTER (30000) 

S 

3 

COMMON/ G  fom/ l  b as  E , K I n, ROU  T , LR I 

,LRO 

,PINF» I  ERR, D  1ST 

S 

4 

EQUIVALENCE (MASTER, AS TER) 

S 

5 

c 

s 

6 

c 

S  RETRIEVES  COORDINATES  OF  ANY 

OF 

THE  6  SIDES  OF  AN  RPP 

S 

7 

c 

I  IS  RPC  NUMBER  N  IS  SURFACE  NUMBER 

s 

8 

c 

s 

9 

L  =  l.BASE<  12*(  I  -  1 )  ♦2*(  N-  I ) 

S 

10 

LL=MASTlR( l* 1 ) 

S 

11 

S=AS  TER I LL ) 

s 

12 

RE  TURN 

S 

13 

END 

S 

14 

c 

s 

15 

c 

s 

16 

SUBROUTINE  CONVKT(FX,IX,LE) 

**** 

20 

DIMENSION  FX ( 6  ) , 1 X ( g ) 

CONVRT  2 

c 

Lt  NUMBER  OF  REFERENCES  TO 

SCALARS  AND  TRIPLETS 

CONVRT  3 

c 

INTEGRAL  PART  OF  FX  CONVERTED 

10  FIXED  POINT  NUM  IN  I X ( I ) 

CONVRT  A 

c 

FRACTIONAL  PART  OF  FX  Co.NVERTEO  TO  FIXED  POINT  NUM  IN  IX(II) 

CONVRT  5 

NFXs ( L6 ♦ 1 ) /2 

98 

CONVRT  6 

c 

c 


c 


c 


c 


00  10  I F  X= 1 »  NFX 

1 1=2* 1 FX 

1=11-1 

IX( I )=FX( IFX)+. 000001 

x= i x (  n 

IX ( 1 1 )  =  ( FX I  I P X )  —  X ) *100000. +  .00001 
10  CONTINUE 
RETURN 
ENU 


SUBROUTINE  OR  10 
DIMENSION  W  P  (  3 ) 

COMMON/PAREM/XBS  3) ,WB(3)  ,  IR 

COMMON/GEOM/LBASE,KlN,ROUT,LRI ,LR0,PINF, IERR.DIST 
COMMON/UNCG£M/NRPP,NTRIP,NSCAL,NBODY,NRMAX,LTRlP,LSCAL,LREGD, 
l  LDATA,LKIN,LROI ,L10,L0C0A, 115, I  30, LBODY.NASC ,KLOOP 
COMMON/C  TRACK/ 01 ,02 , KHI T , LMAX, TR ( 200  ) , XBS I  3 ) , 1 RSTRT , I ENC, 
l  ITRI200I ,CA,CE,SA, SE 

COMMON/C AL/NIK.S IN, ANGIE, NTYP6,S SPACE, L,XS(3),WS( 3) , 

1  TRAVEL, SN, V, H, IVIH 
COMMON/ WALT/ L I RF0»NG1 ERR 
COMMON/HOYT/VKEF ,HREF 
COMMON/C EL L/C  ELS  l  Z 

COMMON /C ON TRL/ ITtSTG»lRAYSK»iENTLV»I VOLUM, IWOT »{TAPE8»N0»1YES 


901  FORMA  I (8110) 

902  FORMAT  ( 6E12«B ) 

903  FORMAT ( IH0,2HNX, 15 ,5X,2HNY» 1 5, 5X , 7HIRSTART, I  5 , 5X ,4H IENC , 15, 5X , 

1  6HNS  TART , 16, 5X ,4HNEND» 1 6 , 5X, 9HCELL  SIZE.F7.2// 

2  17H  OATUM  LINE  AT  Z=,F1G.3,27H  WITH  RESPECT  TO  THE  ORIGIN/ 

3  17H  GROUND  IS  AT  Z=,F10.3,27H  WITH  RESPECT  TO  THE  ORIGIN/ 

A  17H  XSHIFT  IS  AT  X=,F10.3,27H  WITH  RESPECT  TO  THE  ORIGIN/ 

5  17H  YSHIFT  IS  AT  Y=,F10„3,27H  WITH  RESPECT  TO  THE  ORIGIN/) 

904  FORMAT ( 1H  , 7HA Z I  MU TH ,F 12 . 5 , 5X , 9HELEVAT ION, F 1 2 . 5 , 5X , 

1  13HBACK  OFF  0IST.F12.5) 

905  FORMAT ( 2E20.8.4E 10.3) 

906  FORMAT  1 52H0TH! S  KAY  WAS  SUPPRESSED  BECAUSE  IT  WAS  BELOW  GROUND) 

907  FORMAT  < 1H0 , 1  5 , 1SH  CELLS  SKIPPED) 

READ  (5,901 )NX, NY, 1RSTRT,  I ENC ,NGIERR, NSTART ,NEND 
READ  (5,902) A, E,ENGTH,ZSH IF T, GROUND 
READ  (5,902)XSHIFT,YSHIFT,CELSIZ 
I F ( IRSTRT  .LE.O)  IRSTRT=l 
I F (CELS  I Z  .LE.O.  )CELSIZ  =  4. 

IF(NSTART.LE.C)NSTART=1 

IF ( NEND.LE.NS  T AR T) NEND=NX*NY 

IF(NG1ERR.LE.0)NG1ERR=25 


WRIIE  (6,903)NX, NY, IRSTRT,  I ENC, NSTART , NEND, CELS  I Z , 

1  ZSHIFT, GROUND, XSHIFT, YSHIFT 
IF ( IWOT.EO. I  YES) WRITE( 1,905 )A,E, XSHIFT, YSHIFT, ZSHIFT,CELSIZ 
WRITE  (b,904)A,6,ENGTH 
RAOIAN=. 01 74532925 19943 
AR=A*RAD IAN 


ER=E*RA()l  AN 

WRITE  (fa,904)AR,FR,ENGTH 
SA=S I N ( AR ) 

CA=C0S( AR) 

SE=S l N ( 6R ) 


CONVRT  7 
CONVRT  8 
CONVRT  9 
CONVRT 10 
CONVRT 1 1 
C0NVRT12 
CONVRT 1 3 
C0NVRT14 
CONVRT 15 
CONVRT 16 
C0NVRT17 
***♦  21 
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GRID  13 
GRID  14 
GRID  15 
GRID  16 
GRID  17 
GRID  lfl 
GRID  19 
GRID  20 
GRID  21 
GRID  22 
GRID  23 
GRID  24 
GRID  25 
GRID  26 
GRID  27 
GRID  28 
GRID  29 
GRID  30 
GRIO  31 
GRID  32 
GRID  33 
GRID  34 
GRID  35 
GRID  36 
GRID  37 
GRID  38 
GRID  39 
GRID  40 
GRID  41 
GRID  42 
GRID  43 
GRID  44 
GRID  45 
GRID  46 
GRID  47 
GRID  48 
GRID  49 
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! 


ce-cosier) 

c 

C  PROCESS  KL  CELLS  IN  GRID 

C 

1)0  40  KK.-NS  I  AK  I  f  NEND 
w)i !  1  )--U.*CA 
W0(?)=-CF<-SA 
Wtt(  5  )  =  -  ^  £ 

I  I  =  ( I KK-  I  )  /NX ) + 1 
J- KK~ ( I I-l )#NX 

C  COMPUTE  CCOrU*  1  NAT £S  OF  GRID  CELL  IN  GRID  PLANE 

CbLL2  =  .t><:CELSI  Z 

V=f LOA I ( (NY/2) -I  I )  *CELSi Z  +CELL2 
VReF=V+CbLL2 

H=FLOAT( (NX/2J-  J)*CELSIZ  +CELL2 
HRi;F  =  )M-»,ELL2 

I V  =  KAN ( -  I ) *  10. 
lti  =  r<AM-l)*lO. 

I  V  I  )l=  10*  IH+  l  V 

C  CCMPUTp  H,V  AT  RANDOM  POINT  IN  Gfbftt  CELL 

V  =  V*-CELS1Z  <-FLOAT  (  IVJ/10.+CELSIZ  /20. 

M=h+Crl.  j  I  Z  *FLOA  f  (  IH)/10.  +CELSIZ  /20. 

C  X,Y ,L  IN  COORDINATE  SYSTEM  OF  VEHICLE 

XBS(  1  l^XSHIf T-V*CA*SE-H*SA 
XBS( 2)=YSHIFI-V*$A*SEMI*CA 
XP. S  (  3  )  SZ  SH  !  F  f  +  V*CE 
CALL  TR'jP  IC  (  WP  ) 
xsism=xas(  n+wi»m*i.ot-4 

X8S(?)=APS(2)*WP(2)*i.0t-4 
XiJSI  '3  )  =  X  U  S  I  3)  *WP  ( 3)*l.0E-4 
XB (  1 ) =XBS ( 1 ) ~£NGTH*WB ( 1 ) 

XP ( 2 ! =XRS ( 2 ) -cNGTH*W0 ( 2 ) 

XtJ(  3  )  =  X 0 S (  3)-tNGTH*WB(3) 

I  f ( xb ( 3 ) .gt .Ground ) go to  10 
IF(  ITAPEB.EQ. I  YE SI  WRITE  (6,906) 

GOTO  40 

10  DO  20  KK  1  =  l ,  3 
XSIKK1 )=XB(KK1) 

Wb(KKL)=WB(KKL) 

20  CONTINUE 
CALL  TRACK 

IFt  IGRR.GE.NGIERRJkE  TURN 
IF(  IRAYSK.EU.NOJGOTO  40 
MSH IE  T  =  R AN ( -  1 ) *2  5. 

WRI1E  ( 0 ,907 ) MSH I F  ( 

KK-KK+MSHIFI 
40  CONTINUl 
Rt (URN 
bNU 


SUBROUTINE -TRACK 
DIMENSION  XP ( 3 ) , bKROK I  2 ) 

COMMON/ PAR6M/XBI  3 ) ,WB(  3)  ,  IR 

COMMON/GbOM/ LBASF ,RIN,ROUT,LRI,LRO,PINF,IERR,DIST 
COMMON/UNCGbM/NRPP  ,NTRIP,  NSCAL  ,  NBODY  ,  NRMAX,  L  TRIP,  LSC  AL  ,  LP.EGD  , 
1  LDATA.LRIN.LROT, LIO.LOCUA, 115, I  30, L80DY,NA SC ,KLOOP 
C0MM0M/GTKACK/D1 , D2, KH l T , LM AX, TR (  200) , XBSC  3 ) , IRSTRT , IENC , 

I  1TRI200) ,CA,CE,SA,SE 
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GRID 
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GRID 
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GRID 
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GRID 
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GRID 
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GRID 

76 

GRID 
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GRID 

78 

GRID 

79 

GRID 

80 

GRID 

81 

GRID 

82 

GRID 

83 

GRID 

84 

GRID 

85 

GRID 

86 

GRID 

87 

GRID 

88 

GRID 

89 

GRID 

90 

GRID 

91 

GRID 

92 

GRID 

93 

GRID 

94 

GRID 

95 

GRID 

96 

GRID 

97 

GRID 

98 

GRIO 

99 

GRID 

100 

GRID 

101 

**** 

22 

TRACK 

2 

TRACK 

3 

TRACK 

4 

TRACK 

5 

TRACK 

6 

TRACK 

7 

TRACK 

8 
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COMMON/CAL/NlR»S IN » ANGLE, NTYPE »  SSPACEtL  »  XSl 3 ) , WS ! 3 1 » TRAVEL* 

1  SN»V,H,IVIH 

COMMON/CONTRL/ITESTG»IRAYSK»IENTLV»IVOLUH»£WOT,1TAPE8»NQ,IYES 
COMMON/WALT/L IRF0,NGlERR 
COMMON/HOYT/VREF ,HREF 
COMMON/LSU/LSURF 
C0MM0N/CELL/C6LS IZ 
COMMON/ERR/ I ERRO 

901  FORMAT  (F6.1»  LX, F6.  1,  IX,  1 2 ,IX,F7.  2 , IX ,F7.2 ,4(  IX,  ID,  13,  IX, 213, 

1  IX.F8.3, LX,F8.3) 

902  F0RMAT!2{I4,F7.2,F7.2,F6.l,I3,F7.2),lX,2I3,iXf 1 1, 1 1, 12,4X, A6 1 

903  FORMAT (31H  NUMBER  OF  INTERSECTIONS. GT. 2001 

904  FORMAT!//) 

905  FORMAT! 1H0,16H0  ITEM  IN  CELL  < , 14 , 1H, , 14 , 1H) ,5X, 

1  2HH=,F6.l, 5X,?HV=,F6.1) 

ERR0K(2)=  6H0  ITEM 

OATA  ERROR(l) ,ERR0R!2)/4H  ,4HITEM/ 

1 12=4096 
NASC=-i 
I  K= I RSTRT 
L=  1 

KHI T=0 
JCNT =0 
MSKKT =0 
MTARG=1 
MARMR=0 
MVOL  =0 

DO  10  1=1,200 
ITR  < I ) =0 
TR ( I )=0. 

10  CONTINUE 

SI  IS  DISTANCE  THRU  REGION  IR 
I  RPR  IK  IS  NEW  REGION  NUMBER 
XP  IS  POINT  OF  CONTACT 

20  CALL  G 1 ( SI, IRPRI M, XP ) 

IF!  IRPRIM..LT.0  IRETURN 
TR(L)=Sl 
KL  SURF=L  SURF* 7 
LOC=L IRFO+IR-1 
CALL  UN2 ( LOC , DUM , I  DENT ) 

I0ENT=IUENT-1  • 

C  /  SURFACE  NUM  /  BOOY  NUM  /  NEXT  REGION  / 

I TR ( L )  =  ( KLSURF*I 12+N ASC ) *  1 1 2+1  RPR IM 

IF(NASC.LE.NRPP) IRPRIM=0 

IF! IRPRIM.EO.OJGOTO  100 

IR=IRPRIM 

KHIT=KHI T+l 

IF { L.GT • 1 )GOTO  4C 

SUM=0. 

00  30  1=1,3 
SUM=SUM+WS ! I ) *XP ( I ) 

30  CONTINUE 
Dl*-SUM 
GOTO  60 
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TRACK  44 
TRACK  45 
TRACK  46 
TRACK  47 
TRACK  48 
TRACK  49 
TRACK  50 
TRACK  51 
TRACK  52 
TRACK  53 
TRACK  54 
TRACK  55 
TRACK  56 
TRACK  57 
TRACK  58 
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i 


CHtc'K  I  DENT  CODE  0  NONE 

lO=SKIRr  20=ARM0ft  30  =  T  ARGET 

SPACE  COOES  l  EXTERIOR  VOLUME 

-1,2-0,1  1-19,21-29, . ,91-99  INTERIOR  VOLUME 


40  IF(  WEN  I  .EU.OGOTO  60 

1  F  (  IDENT-I  I  0 1 N T /  10)*10.EC.0)G0T0  50 
Kill  I  =KH  I  T-l 
I  F  (  I  otr:  I  .  NE  .  I }  MV  OL  =  l 
GOTO  60 

r 

60  1 F ( IDEM  I .  LQ. 20 )MARMR= l 
I F ( IOENI . tC . 30 )M IAKG= 1 
I F ( lOtNT.EQ. lv)MSKRT=l 
60  L  =  LM 

IF{L.LF.200)C0T0  20 
WRITE  (6,903) 

S  I  UP 

EMI.  OF  RAY  PRINT  RESULTS 

100  IFIL.SO. I ) RE  TURN 

I F (  l IAPL6.F0.N0. AND. I  WO T . EO .NO )RE TURN 

l)?  =  AU  I  S  T  (KRS,XP)-S1 

U2=-f)2 

IFIKHI r.GT. 0)6010  105 
kiii  t=khi  r ♦  i 
k r  AKG=0 

105  Kri i  r=i.ui  r-i 

I  H=  ASS  ( H/CELS  I  Z  )  •*■ .  5 
1FIM.LT.0.  )  I  H=-I  H 
I V=ABS ( V/CELS  IZ  J  +  .5 
IFIV.LT.O. ) IV=-I V 

PRINT  CARO  NUM  1 
IF(  1  !  API: 3. EO. NO) GO  10  110 
WRITE  (6,904) 

WR lit  (6, 901) HREF, VREF,I VIH,01 ,02, MSKRT , MTARG, MARMR ,MVOL , 

1  Mil  T,  IH,  IV,H,V 

110  I  F ( IWCT.LU. I  YES (WRITE!  1 , 901 ) HREF , VREF , IV  IH , D 1 , U2 , MSKRT , MTARG , 
1  MAR MR , M VO  L ,K  H I T , IH, I V,H,V 


PRCCtSs  GOMPuNcNT  CAROS 


C 

c 

c 


LMAX=L 
L  =  0 

,TRAVEL=  I  K(  l  ) 

NIR  REGION  I  CENT  I F IC A T ION  I VOH ICLE  COMPONENT) 

SIN  L I Nfc-OF- SIGHT  DISTANCE 

ANGLE  0RL1CUITY  ANGLE 

SN  NORMAL  DISTANCE  THRU  REGION 

NTYPE  TYPE  OF  SPACE  AFTER  NIR( NONE=0,END  RAY=9) 

S SPACE  L I Nt-OF-S l GH T  01  STANCE  THRU  SPACE 

1)0  20C  KlK-l»LMAX,2 
JERRO= 1 
L  =  L  + 1 

IFIL.CE.LMAXIkETURN 

CALLCAlC  102 

IFINIK.NE.OJGOTO  lli 


TRACK  69 
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TRACK  74 
TRACK  75 
TRACK  76 
TRACK  77 
TRACK  70 
TRACK  79 
TRACK  80 
TRACK  SI 
TRACK  82 
(RACK  83 
TRACK. 84 

Track  85 

TRACK  86 
TRACK  R7 
TRACK  88 
TRACK  89 
I  RACK  90 
TRAi^K  91 
TRACK  92 
TRACK  93 
TRACK  94 
TRACK  95 
Track  96 
TRACK  97 
TRACK  98 
TRACK  99 
TRACK  100 
TRACKLOl 
TRACK  102 
TRACK103 
TRACK  104 
TRACK  105 
TRACK  1 06 
TRACK107 
TRACK  1 08 
TRACK  109 
TRACKl 10 
TRACK1 11 
TRACK l 12 
TRACKl  13 
TkACKI  14 
TRACK  115 
TRACKl 16 
TRACKl  17 
TRACK  118 
TRACKl 19 
TRACK120 
TRACK  121 
TRACK  122 
TRACK  123 
TRACK  124 
TRACK125 
TRACK126 
TRACK127 
TRACK  128 
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c 


c 


c 

c 


JEP.R0=2 

I£RR0=1ERR0«-1 

113  IF(SSPACE.NE.O.) JCNT*JCNT>1 
NIR1=NIR 
SIN1=SIN 
ANGLE 1=ANGLE 
SNl=SN 

NTYPE i=NTYPE 
SSPACE1=SSPAC£ 

SECOND  HALF  OF  CARD 
L=L+1 

IF(L.LT.LMAX)GOf 0  115 

NlR=0 

SIN-O. 

ANGLE=0. 

SN=0. 

NT YPfc=0 
SSPACE=0. 

GOTO  120 
115  CALL  CALC 

IFINIR.NE.OJGOTO  117 

JERK0=2 

IfcKKO=IERRO+l 

117  IF(SSPACE.EC.O.)GOTO  130 
120  JCNT  =JCN T+ 1 
130  11=0 
12=0 

N=L-JCNT 


TRACK  129 
TRACK  1 30 
TRACK  131 
TRACK  1 32 
TRACK  L33 
TRACK  1 34 
TRACK  135 
TRACK  136 
TRACK  137 
TRACK130 
TRACK  130 
TRACK l AO 
T  RACK  1 A  1 
TRACK  1 42 
TRACKU3 
TRACK  144 
TRACK  145 
TRACK  1 46 
TRACK  14? 
TRACK  1  A3 
TRACK149 
T  RACK  1 50 
T  RACK  151 
TRACK l 52 
TRACK  153 
TRACK  1 54 
TRACK  1 55 
TRACK l 56 


140 


150 


TRACK  FLAG  501  IS  TRACK  EDGE 
10  IN.  NORMAL  THICKNESS  IS  CUTOFF 

IF(NlRl.Nt.50l)GOTO  140 
IFISN1.LT. 10. )NIR1=502 
IF(NIR.NE.501)G0T0  150 
IF ( SN  .LT.10. JNIR=502 

PRINI  COMPONENT  CARO 


502  IS  TRACK  FACE 


I F ( IWOT.  EQ. I YfcSIWR I TE(1, 902 )N I Rl,SlNl,SNl, ANCLE  UNTYPE  1, SSPACE 1, 
1  N IR, S I N,SN, ANGLE, NTYPE, SSPACE, IH, IV, I l, I 2,N 
IF ( I  TAPE  8. EO. IYES)WRITE(6,902JNIR1,SINI,SN1, ANGLE1 ,NTYPE l, SSPACE 
1  N I R, S I N,SN, ANGLE, NTYPE, SSPACE, IH, IV, II, I  2, N, ERROR! JERRO) 

IF ( ITAPE8.E0.N0. AND. JERR0.EQ.2I WRITE  16, 905)1 H, I V.HRCF.VREF 


IFIL.GE.LMAXJRETURN 
IF (NTYPE  .EQ.9IRETURN 
200  CONTINUE 
RETURN 
END 


SUBROUTINE  CALC 

DIMENSION  MASTER  ( 30000  >,XP(  31,  TEMPO),  TEMPI  (  3  ),TEM(  3  ),TEMl(3>, 

1  XMID ( 3 ) » I EMP (4 ),WNC3),WI(3),HA(3),XI(3 ) , AUNl 3),HFC3), 

2  VF(3),0(3),DELTA(3),ARSTPO) 

COMMON  ASTER ( 30000 ) 

COMMON/ PAREM/XBJ  3 ) ,WB( 3) , IR 

COMMON/ GEO M/ LB AS E ,RI N, ROUT ,LRI,LRO,PINF, IERR ,OIST 
COMMON/UNCGEM/NRPP ,NTR IP , NSCAL ,NBODY ,NRMAX,LTRi P,LSCAL,LREGO, 


TRACK  157 
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TRACK  160 
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T  RACK  16? 
TRACK  163 
TRACK  164 
TRACK  165 
TRACK166 
TRACK  167 
TRACK  168 
TRACK  169 
1 ,  TRACK  170 
TRACK  171 
TRACK172 
TRACK  173 
TRACK174 
TRACKl 75 
TRACK  1 76 
TRACK  177 
TRACKl 78 
TRACK  1 79 
TRACK l 80 


**** 

CALC 

CALC 

CALC 

CALC 

CALC 

CALC 

CALC 


23 

2 

3 

4 

5 

6 

7 

8 


103 


o  o  r 


1  Li’AlA.l  <I\,l  H  ’T.LIO.LOCOA, 115,  130,LB0DY,NASC,KL00P 
U.JKH>  N/  .lKAUv/1,1  ,0? ,  KH  i  T  ,  LMAX  ,  TR  (  200  1  ,  XBS  ( 3  )  ,  IRSTRT, IENC, 

1  fl'M  ’•  ‘>l,LA,Ct  ,SA,  SF 

i  IN.ANGLr  , NT YPE ,S SPACE , L , XS (3) , W$ < 3 1  .TRAVEL, 

l  iv in 

t  jW  .>\/w.U  r/L  I  Rf  i_ ,  M,  l ERR 
t  JIIWAI  ‘  NT  t  { HAM  Ek  ,  Ail  tK  ) 

<CAL  'if  f  M 

L 

iil  FUKVAI  I  I r* ,  13HTHA1  5  ALL  FOLKS//} 

n:  i  >«M\)  J  I,n  ,  17HH\1  H  YPE  IN  CALC,  5X.6H1  TYPE®,  15»4HNB0  =  ,  15/ 
l  lt»  It,  TURN  TO  T»AlK//) 

?Ji  h.ifU’AHl"!  ,/^HAifi  nil,  NOT  FIND  NORMAL) 

JJ4  MHM/3P  •llR=,llu,5X,6HiTYPE=,I10,5X,4HNli0=,110,5X, 

I  MU  jilt  I  *,  llu/4H  k«s,  3L20.  10/4H  WS= , 3E20. 10/4H  XP=,3t20.B/ 

«,i.  XU  ,  11-20.  1C./4H  X  I  =  , 3fc?0. 1 0/ 6H  XNOS=,  3E20.  10) 

J  j  3  f  JK.  Ult'ii  I  XiOk  in  calc  A  TKC  HAS  R1  =  R2  ) 

Dh  t  (i,/H  («KOt  IN  CALC  BAD  LStJRF  FOR  BOX  OR  RA*  > 

•  /  mini  Aw>  Ni)*v  /  BODY  NUM  /  NEXT  REGION  / 

l 

OAlL  •<!»  Null  » L  SUkF  ,  NBO  ,  N I  R  1 
|M  i1K*hI  .Cll^’TO  1  c 
mtllr  H.901) 

R._  !»,<% 

‘  IRA/-.  L  LlNE-W-SlGHT  U I  ST  TO  IHIS  REGION 

i  Xj  SI  ART  INI.  POINT  <XS  =  XI3) 

o  siN  l  IM -OE-SIGHT  LUST  IHRU  THIS  REGION 

C 

10  S  I  M=  T-%  (  L  *  I  ) 
lO  2’i  1*1,3 

XI  I  I  )*XS(  I  )  ♦IkAYEL*W$(  I  ) 

20  CuNTINUf 

TRAVEL*.  TKAVLL+SIN 
LSUKF=LSUKF-7 
L 

XNOS=L. 

IFILSUKF.LT. 01XN0S--1. 

L‘JL  =  LT>0UYi3*(Nl)J-l  ) 

CALL  UNIMLOC,  1  TYPL.LOATA) 

L SURF 5  I  AL'S  I  LSURF  ) 

1 f  YPc -  I  I YPL ♦ l 

If-Il  I  YPF.OE.  l.AND.  I  TYPE.  L  6.  12)  GO  TO  30 
Wit  l  TL  1 6,902)1  TYPE ,NBO 
RE  TURN 
C 

C  COMPUTE  NORMAL  OIST  AND  OBLIQUITY  ANGLE 

L 

C  KPP  BOX  SPH  RCC  KEC  TRC  ELL  RAW  ARB  TEC  TOR  ARS 

30  GO  TO (50, 100,150, 200,200, 300,350, 400,450, 500, 550,600 ) , I  TYPE 

CHECK  Fv'R  SPACE  COOES  IOLNT  =  - 1 ,  1-9 , 1 1- 19, 21-29 .....  ,91-99 

40  CALL  CPFNK ( L  +  l ,OUM , DUM, NEXRtG ) 

I  SPOT-L  IREO  +  NEXitEG-1 
CALL  UN2 ( I  SPOT ,DUM, IOENT ) 

I  SPO  T  =L  I RFO ♦!.'  1 R-  1 
CALL  UN2MSP0I  , NIK, HUM) 

10ENT= IDENT-1  104 


CALC  5 
CALC  10 
CALC  II 
CALC  12 
CALC  1  t 
CALC  14 
CALC  15 
CALC  16 
CALC  1  i 
CALC  18 
CALC  19 
CALC  20 
CALC  21 
CALC  22 
CALC  21 
CALL  24 
CALC  25 
CALC  2o 
CALC  27 
CALC  28 
CALC  29 
CALC  30 
Calc  3 1 
CALC  32 
CALC  ^3 
CALC  1. 
CALC  i- 
CALC  36 
CALC  3/ 
CALC  38 
CALC  39 
CALL  40 
CALC  41 
CALC  42 
CALC  43 
CALC  44 
CALC  45 
CALC  46 
CALC  47 
CALC  48 
CALC  49 
CALC  30 
CALC  31 
CALC  52 
CALC  53 
CALC  54 
CALC  55 
CALC  56 
CALC  57 
CALC  58 
CALC  59 
CALC  60 
CALC  61 
CALC  62 
CALC  63 
CALC  64 
CALC  65 
CALC  66 
CALC  67 
CALC  60 


o  o  o 


C  CHECK  FOR  SPACE  COOES  IOENT  «  -1,1-9,11-19,21-29, 

I F ( IDENT-I IOENT/ 10 )*10.NE.0)G0T0  41 
NTYP£=0 
SSPAC£=0. 

RETURN 

41  L=L  +  i 

IFILU.LT.LMAXIGOTO  42 

I0£NT=9 

SSPACE=1.0E-4 

NTYPE= IOENT 

RETURN 

42  NTYPE=IOENT 
SSPACE=  TR{ L  + 1 ) 

TRAVEL  =  TRAVEI.+SSPACE 
RETURN 

RPP 


C 

C 

C 


50  lF<LSURF-2)52,53,54 

52  XNOS=-XNOS 

53  1  =  1 
GOTO  60 

54  Jf(LSURT~4 155,56,57 

55  XNOS=-XNOS 

56  1  =  3 
GOTO  60 

57  IF ( LSURF .GE .6 1G0T0  59 
XNOS=-XMOS 

59  1  =  5 

60  LKK=LBASF+2*I+1 
LVI=MASTER(LKK 1 
LKK=LKK+2 
LV2=MASTER(LKK) 

DO  62  J=  1 , 3 
M=J-1 

I JK=M+L V 1 

TEMPI  J)=ASTER<  UK) 
IJK=M+IV2 

TEMPI (J)=ASTFR( I JK) 

62  CONTINUE 

CALL  OCOSPITEMP, TEMPI, WB) 

00  63  J=l,3 

WU  ( J 1 =XNOS*WB ( J 1 

63  CONTINUE 
GOTO  1000 

BOX 


100  CONTINUE 

KC0M=LSURF-(LSURF/2)*2 
IFIKC0M.E0.01XN0  S=-XN0S 
IFILSURF-3) 104,103,105 

103  1  =  1 
GOTO  110 

104  1=2 
GOTO  110 

105  IFILSURF.LT. 51G0T0  103 
1  =  3 


110  CALL  UN2  <LOATA,I EMPI4) ,IEMP(1)  I 


CALC  69 
CALC  70 
CALC  71 
CALC  72 
CALC  73 
CALC  74 
CALC  75 
CALC  76 
CALC  77 
CALC  78 
CALC  79 
CALC  80 
CALC  81 
CALC  82 
CALC  83 
CALC  84 
CALC  85 
CALC  86 
CALC  87 
CALC  88 
CALC  89 
CALC  90 
CALC  91 
CALC  92 
CALC  93 
CALC  94 
CALC  95 
CALC  96 
CALC  97 
CALC  98 
CALC  99 
CALC  100 
CALC  101 
CALC  102 
CALC  103 
CALC  104 
CALC  105 
CALC  106 
CALC  107 
CALC  108 
CALC  109 
CALC  110 
CALC  111 
CALC  112 
CALC  113 
CALC  114 
CALC  115 
CALC  116 
CALC  117 
CALC  118 
CALC  119 
CALC  120 
CALC  121 
CALC  122 
CALC  123 
CALC  124 
CALC  125 
CALC  126 
CALC  127 
CALC  128 


10S 


CALL  UNPlLOATA.i FMP(2)» !EMP{3I) 

Do  11 5  J  =  1 , 3 
LM=!F.MP{  1  ) 

LV-I: MP{ A) 

M-J-  1 

1  JK-Lli+M 
lJKi=LV*N 

TfcMPI J)=ASTrK( IJK)+ASrEK( IJKl) 
lbMP(A) 

TEMPI (J)=ASTfcR(MK) 

113  CONTINUE 

CALL  DCi;SP  <  TEMPI  ,  TfcMP»WB  ) 

00  1?0  J  =  l,J 
WB(J)=XN0S*W8(  J) 

120  CONTINUE 
0010  1000 
C 

C  SPH 

C 

15C  CALL  ON2(L0ATA,LV,L)UM) 

DO  160  1=1,3 

«  -  1  -  1  ♦  L  V 

IcMI  1  )  =  A  S  T  f:  R  (  M  ) 

160  CON  f  1  NUv 

CALL  DCOSP1XI  ,TFM,Wt}> 
uv  I/O  1=1,3 
rttH  I  )  =XNOS*wB( I ) 

170  CONI  IfJUc 

core  iooo 
c 

C  kCC 

c 

200  lFUSURF-21202,201,210 

201  XNOS= - XNOS 

202  CALL  UM?(LDAIA,LV1,LV21 
DO  203  1=1,3 

K  =  I  -  l 

1  JKl=K  +  l.Vl 
IJK2=M+LV2 
TLM(  I  )  = AS  TFx (  UK  1 ) 

TLMl  m=ASUKf  IJKll+ASTfcR!  IJK2) 

203  CONTINUE 

CALL  OCOSIM  TEM.TLMl.WB) 

DO  204  1=1,3 
Wtt { I  )=XNOS*WB! I ) 

204  COMTlNUt 
GOTO  1000 

C 

C  DIR  COS  FOR  NORMAL  TO  SURFACE  ONE  OR  TWO  - 

C  MOW  HAVE  TO  GET  FROM  A  POINT  TO  THE  HEIGHT  VECTOR 

C 

210  CALL  UN21LCATA,LV,LH) 

LRl=MASTER(LOATA+l ) 

DO  21 1  J=1 ,3 

M=J-l 
1  JK  =  LV+M 

TEM(J)=ASTER(IJK) 

I  JK  1  =  LH  +  M 

TEM1(J)= ASTER! I JK  )  +  ASTER { IJKl)  106 

211  CONI  1 NUE 


CALC  120 
CALC  130 
CALC  131 
CALC  132 
CALC  133 
CALC  134 
CALC  135 
CALC  136 
CALC  137 
CALC  138 
CALC  130 
CALC  140 
CALC  141 
CALC  142 
CALC  143 
CALC  144 
CALC  145 
CALC  146 
CALC  147 
CALC  148 
CALC  1 40 
CALC  150 
CALC  151 
CALC  152 
CALC  153 
CALC  154 
CALC  155 
CALC  156 
CALC  157 
CALC  158 
CALC  159 
CALC  160 
CALC  161 
CALC  162 
CALC  163 
CALC  164 
CALC  165 
CALC  166 
CALC  167 
CALC  168 
CALC  169  ‘ 
CALC  170 
■  CALC  171 
CALC  172 
CALC  173 
CALC  174 
CALC  175 
CALC  176 
CALC  1,77 
C'ALC  178 
CALC  179 
CALC  180 
QALC  181 
CALC  182 
CALC  183 
CALC  184 
CALCi  185 
GALC  186, 
'  CALC  187' 
■■  CALC  188 


I 


V 


I 


I 


c 
.  c 
c 
c 
c 

•  c 


I 


CALL  0COSP(TEM,XI,WN) 
CALL  DC0SP<TEH,FEM1,HI) 
SUM=0. 

‘  '  00  '212  J  =  1  #  3 

SUM=SUM+WN( J)*WI I  J) 

212  CONTINUE  '  , 

00  214  J  =  1 » 3  j 

XP( J)=SUM*XOIST(TEM,XI ) 

,  XPIJ)=XP{J)*WI{J)+TEHIJ) 
214  CONTINUE 

’ I F  (  IjTYPE.  EC..5  )  GO  TO  250 
CALL  DCCSP I  X I >  XP  » WB) 

00  220 : J  =  1 » 3  , 
WBm=XNOS*Wfi{  JJ 
220  CONTINUE 

QOTO  1000  1  i  1 


1  ■ 


KEC 


I 


;  ! 


FOR  SURFACE  1  AND  2  NORMAL  IS  SAME  AS  RCC 
FOR  SURFACE  3  'JUMP  OUT  WHEN  'XP 1 1  1  *PQ  JNT  ON  HEIGHT  VECTOR 

•  S  •  • 

250  L0A1 A=L0AT A+ 1  ,  ‘  ,  ! 

CALL  UN2(LDATA,LR1,LR2)  i 
00  255  J  =  1  >  3  -  , 

M=  J- 1!  * 

i  I  JK'l=M+LRl  •  ’  ‘ 

TEMPI J)=ASTER( IJK1J  +  XPIJ)  ■ 

.  IJK2=M,+  LR2  ■■  '  > 

rEMPl(J)=ASTEk(lJK2)+XP(J)  I 
255  CONTINUE 

•  1  A1=X0IST (XP»TE MP)  , 

A2=X0I  ST  ( XP ,  T.EMP  1 )  1  i  . 

IFIA1.GE.A2JGOTO  260 

A1*A2  ‘  .  •'  ».  ‘  .  .  •  •  ,  l 

A3=A1  , 

A2=A3 | 

TEMPI l)=TEMPl(l)  :  ‘  ’  .  ! 

,  T6MP(2j=TEMPl(2) 

TEMP  l  3 )  =  T.EMP  1 1  31  i  ;  • 

260  C=SORT{ A1»A1-A2*A2) 

,  CALL  DCOSPIXPiTEMP.WN)  •  ‘ 

00  265  J=  l.»  3 

TEMI  J)=XPI  J)+C*WN{  J,)  !  ,  . 

i  TEMl(J)=XP(J )-C*WN I J )  ‘ 

265  CONTINUE  '  ; 

CALL  DCOSP  I  T'EM»X  I  »I*N  ) 

'  00  270  J  =  1 » 3 

TEMI  J)=2,*A1*WN(  J)'+TEM(J>  • 

270  CONTINUE  . 

CALL  0C0SPITEM,TEM1,WB>  ;  ; 

DO  275  J  =  1 »  3  ' 

WBI  J)=XNOS*kB(  J)) 

275  CONTINUE 

GOTO  1000  '  ... 

i  ' 

TRC  '  1 


C 

.C 

C. 


300  IFILSURF.LE.21G0  TO  320 
CALL*  UN2IL0ATA»LV»LH) 


107 


i  i 


CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
1  CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC  . 
CALC 
CALC 
CALC 
'CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC' 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
1  CALC 
CALC 
CALC 
CALC 
CALC 
!  CALC 
CALC 
CALC 
;CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
CALC 
,CALC 
CALC 
CALC 
CALC 
CALC 


189 

190 

191  ‘ 

192 

193 

194 

195 

196 

197 

198 

199 

200 
201 
202 

203 

204 

205 

206 

207 

208 

209 

210 
211 
212 

213 

214 

215 

216 

217 

218 

219 

220 
221 
22.2 
lii 

224 

225 

226 
227 
*228  3 

229 

230 

231 

232  , 

233  ' 

234 
2-35 

236 

237 

238 

239 

240 

241  1 

242 

243 

244 

245 

246 
:247 

248 


-  a 


l 


! 


ortn 


i 


Luaia-luata+i 

CALI  CM2  (  Lf)A  F  A  ,L  R  l  ,  LR2  1 

0  i  F  =  A  S  r  t  K(L»U  )  -A  STf-R  1  LR2  ) 

II- (u  If-  1302,301,303 
30  1  w:<  ||;  (  o ,  so 5  l 
b  roc 

30  2  r-M|>{  l  >  =  L  |<  I 
LK-l.'I  <•'? 

L«2  =  l 1  MC  (  !  ) 

L'lf  *A0S(()ll-  ) 

303  f  Al,  Fl{  =  Ab  TFR  (  LK  1 J  /D  IF 
!’m  30  A  J-1,3 

K  =  J-1 
I JKsM*  LV 
I  JK  l  sMH  H 

r  t-MP  i  (  j  )  =  A  s  T  FK  {  !  JK) 

)  sASTbft  (  IJK  )  *FACrR*ASTER{  |  JK1) 

304  CONIINUl 
I  i)  I  S  =  XO I  S  i  (  X  I  ,  1 1-  M> ) 
sOis=xoi  sr  i  r t- y i> i ,  r imp j 

lALL  DCobP  (  ILCP,  X  I  tWN  ) 

CALL  OC  >SS>  {  |  FKP,  TFKP  l  ,WA  ) 
bUC--  . 

UU  310  J-1,3 
bl)M-WN(  J  )  *  w  A  (  J  )  fSUM 

310  CONTI  MIL 
(.SUC=Ft)l  b/SUc 
CPtS=QDl S-OSUK 
CO  311  J=  l ,  3 

r  (-  MP  (  J  )  =  -  OP  l  S  *  W  3  (  J  1  +  F  F  MP I  ( J  ) 

311  CONIlNUL 
CALI.  OC.  SPIXI  ,  FF.CP.wO) 

C<J  312  J  =  l  ,  3 
WI5  {  J  )  =  XN0S*'a8  (  J) 

312  com i i Nut 

00 FO  10 JO 

32  0  i f  ( i. surf . lq. 2 ) xmos  =-xno$ 

CALL  UN2  (  1.  OA  T  A  ,  L  V  ,  LH  ) 

CO  32  1  JM,3 
M- J-  1 
iJK-MfLV 

FcMPI  J  )  sASFtR  (  UK) 

I  J  K  1  =  M  +  L  M 

I'lMPI  {  J  )  =AS  FTKI  I  JK  )+ASFtft(  IJK1  ) 

321  COnriNUL 

CALL  DCJSPI TLCP, TUPPl.Wb) 

CO  322  J-1,3 

Wb( j) =XMCS*wB( J) 

32  2  lONIMUl 

core  looc 

LLL 

350  CALI  UMf.  (L0AFA,LRl,LR2) 

Lb=MA$FciU  LCAFA+  l ) 

00  352  J  =  l  ,  3 
V=J-l 

i  JK1-F  +  LR1 
1  JK?  =  v  +  lR2 


CALi.  .‘4  > 
CALC  2 *>o 
CALC  251 
CALC  25? 
CALC  253 
C  A  l  C  i.  >  4 
CALC  2 V> 
CAU",  250 
CALC  25 t 
CALC  25 H 
CAU,  2  *  i 

Calc  2 *  *  ■ 
CALC  20 t 
CALC  2o > 
CALi,  2o  i 
CALC  204 
CALC  205 
CALC  5*.i. 
C  *a  L  C  2 1 1  / 
CALC  ?<„ 
CALC  2  0  5 
C  A  t  C  2  /  ■ # 
CALC  2c. 
CALC  2  ( 
CALC  2/3 
CALC  2/4 
C  A  l  C  2  c1' 
CALC  2  ■ 
CALC  2// 
CALC  2/H 
CALC  2  (') 
CALC  2<.  ) 
CALC  2U 
CALC  282 
CALC  283 
CALC  284 
CALC  205 
CALC  280 
CAlC  28? 
CALC  2«k 
CALC  2’<o 
C  ALl  .  A1 
CALC  2  0 1 
CALC  2 02 
CALL  2ji 
CALC  2 54 
CALC  2 V5 
CALC  ?v/ 
CALC  25/ 
CALC  2 50 
CALC  255 
CALC  300 
CALC  301 
CALL  30? 
CALC  303 
CALC  3U4 
CALC  305 
CALL  3C6 

i®8  CALL  30/ 

CALC  308 


r>  n  o  o  o 


352 


354 


400 


401 


IEM(J)sASTER(IJKl) 

IEMH  J)=AST£R{  IJK2) 

CALC  309 

continue 

CALC  310 

A=ASTER(LS) 

CALC  311 

CALL  DCOSP( TEH.Xi.WN) 

CALC  312 

DO  353  J=1 , 3 

CALC  313 

TEM( J)=A*WN( J 1+T  EM( J ) 

CALC  314 

CONTINUE 

CALC  315 

CALL  DC0SP(T£M,TEM1,WB) 

CALC  316 

DO  354  J=1 , 3 

CALC  317 

W8(J)=XN0S*WB(J) 

CALC  318 

CONTINUE 

CALC  319 

GOTO  1000 

CALC  320 
CALC  321 

RAW 

CALC  322 
CALC  323 

!.HiLWlLl  SHAPE  THE  BOX  FOR  LSURF  =  l,3,5,6 

CALC  324 

JUMPS  TO  100  TO  INDICATE  BOX  PORTION 

CALC  325 
CALC  326 

IF ( LSURF .EQ.21G0T0  401 

CALC  327 

IF(LSURF.NE.4)C0T0  100 

CALC  320 

WRITE  (6,906) 

CALC  329 

STOP 

CALC  330 

C 

C 

C 


CALL  UN2 (LOATA.LV. LVl) 

LDATA=LDATA+1 
CALL  UN2 (LDATA.L V2.LV3) 

00  410  J  =  .U3 
M=J-l 

I  JKl  =  M+LVi 
IJK2=M+LV2 
TEMP( J)=AST£R( IJK1) 

XMIU(J)=ASTER( IJKll-ASTERlI JK2 ) 

I  JK3=M+LV3 

TEM( J)=ASTER( 1 JX3) 

410  CONTINUE 
1  =  1 

J  =  2 
K=3 
LK=0 

00  411  KK=1,3 

TEMU  n=XMlO(J)*TEM(K)-XMJOIK»*TgMCJ) 

LK  —  ( 

i=j 

J=K 

K=LK 

411  CONTINUE 
SUM=0. 

00  412  J  =  1 , 3 

SUH*TEM1 ( J  >*TEMP ( J I+SUH 

412  CONTINUE 
SUMs-SUM/ A8S ( SUM ) 

.  3 1  ..2 

00  420  J=l,3 

WB(JI=XN0S*SUM*TEM1( JI/TLK 
420  CONTINUE 
GOTO  1000 


ARB 


109 


CALC  331 
CALC  332 
CALC  333 
CALC  334 
CALC  335 
CALC  336 
CALC  337 
CALC  338 
CALC  339 
CALC  340 
CALC  341 
CALC  342 
CALC  343 
CALC  344 
CALC  345 
CALC  346 
CALC  347 
CALC  348 
CALC  349 
CALC  350 
CALC  351 
CALC  352 
CALC  353 
CALC  354 
CALC  355 
CALC  356 
CALC  357 
CALC  358 
CALC  359 
CALC  360 
CALC  361 
CALC  362 
CALC  363 
CALC  364 
CALC  365 
CALC  366 
CALC  367 
CALC  368 


4**  t  *  1  f  -  J 

*H>  *  n  .*’«  ,;•»*», i  j  } 

'  4  ’  i  !  t  ,  t 

V  j  .  i 

1  i*  ‘Ui 

■  v  •*»  *  .  t  ■  -  f  1  j*  ,  **  / 

45  1  .IT 

1  *  ■(!  i  «| 

‘1,1 

"  J  t 

l  i'  ',<ti 

w  1)1  X’„  H’,I‘KUi<U/tMV 

46  •  <  ■  M  f  ,11* 

<•  1  * 

I 

l»(f  -.'f  ,1  t  fi 

’•  '*■*  ’*  <H  M'mI 

L  A  (  - 1  \  f  A  ♦  t 

‘-’li  l  1  U  'Hi.l'.U) 
l  -Vl  i  *  ld»  | 

•  Au  ‘  '  *1*  *IA»1«1.IR2I 
I  n  ”  V.r»  ’  U  M \*  1 1 

*  I  -  3  .1 1  *  ft  4  1  l 

-  *  v.r*  ill  -i.'l 

<  t  /  A  ,  I  I  J 

►  '/ft',  I,  V  jtktl 

X’.fN-a  * 

H.l'ii  . 

VHV<  . 

HiiAi  , 

HuK  ■»  <, 

. 

*j  -  v:  i  i  i,i 
i  i*i-i 

Jl  -IV,I1 

n  h»o  1 1 

Ji'LN,  l  1 
J4HAMI 

t'fcL  T  A  (  |  1  t X  |  <  I  J  -AM  t-K  (  J  1 J 
HH  I  1  i  A  ,  I>  «{  j  -  1 
AuN  I  i  )  *u  i  f  |  4  (  j4  j 
NHD-Ajlmuii 

VH  Jl» 

XtW-iXK  I  l«NH|l‘Xmj 
i  5  J*NH  |  )*wiN 
VtIU-vh  I  I  )*\H  l 

tau  j  *nf 1 1 1  »m>*i 

H»lA«Hf  (  I  I  *AUN(  I  }  f M|/A 

501  tour i ",ui 

CALI  r.K  ’SS(w,  Ail’I.fJFJ 
MUK  =  !)  nnl’.tl 
1  1  =  X0*,/HI  I. 

12  =  VUN/H»>N 
U0  50?  U|,3 

rtMMI  I  )  -XI  (II -T|  ♦HM  I  I-VF  ( I  )  +  r2*HF  1 1  I 

502  con r 1 NUt 
TAUMK3/RI.)**/' 

no 


CALC  i 61 
CALL  370 
CALC  171 
CALC  372 
CALC  373 
CALL  374 
CALL  m 
CALL  3  76 
CAU  3?  7 
CALL  378 
CALC  3  79 
CAL  t,  300 
CALc  381 
CALC  38? 


CAI  t 

38  3 

CAL'. 

3H4 

cAli 

3  JK 

CAL  i 

JH6 

CA* 

,  K  7 

CAU 

• 

CAlt 

3*V 

OAC*. 

l’/U 

CALL 

1)1 

Call 

*9? 

CAL 

3/3 

CALC 

1  14 

CALC 

3  4S 

CALL 

a*//. 

CALL 

3*17 

CALC 

318 

CALC 

311 

CAU 

ur> 

CAL*. 

U! 

CALC 

40? 

CALC 

40} 

CAlt 

404 

CALC 

405 

CALL 

406 

CALC 

407 

CALC 

408 

Calc 

401 

CALC 

MC 

CALL 

4U 

CALC 

4l? 

CALC 

413 

CALC 

414 

CALC 

415 

CALC 

416 

CALC 

417 

CALC 

418 

CALC 

411 

CALL 

4?n 

CALC 

421 

CALC 

42? 

CALC 

423 

CALC 

424 

CALC 

425 

CALC 

426 

CALC 

427 

CALC 

428 

o  o  o  r>  o  o 


T3=00T ( TEMP , AUN) /TAU 
T4*00T I TEMP  ,  C ) 

GAMMA* ODN/ HON 

EM=GAMHA*R4+ 4 1 .0-GAMMA)*R2 
T5=HOA/HON 
T  6=H0K/HDN 
00  5 10  1=1,3 

WBI l )=XNOS*{ 13*< AUN( I )-T5*NF( 1)1+ 

1  T4*(Qm-T6*NFlI  ))-EM*(R4-R2)*NFm/HDN) 
510  CONTINUE 

CALL  UN i 1 ( WB ) 

GOTO  1000 

520  IF!L$URF.EG.2)XN0S*-XN0S 
CALL  UN2(LDATA,LV»LH) 

LOA  f  AFLOAT A* 1 

CALL  UN2(L0ATA»LN,UUM) 

00  521  1=1,3 
J=LN  +  I--1 

WB  t 1 ) =XNOS* ASTER ( J 1 

521  CONTINUE 
GOTO  1000 

l  OK 

550  CALL  UN2(LDATA,LV,LN) 

loata=loata+  1 

CALL  UN2(LDATA,LRl,0UM) 

00  551  1=1,3 

J=I-1 

IJK=LVU 

TEMP  (  !  )  *Xl  (  I  )- ASTER!  UR) 

I  JK=LN* J 

TEMP  1 1  I  )  -A S TEH <  UK) 

551  CONTINUE 
R1=ASTER(LR1) 

CALL  CROSSITEM, TEMPI, TEMP) 

CALL  CROSS! TEMl, TEM, TEMPI) 

CALL  UNIT(TEML) 

UO  552  1=1,3 
J=i-l 
l  JK  =  L V  + J 

TEM! I )= ASTER ( IJK ) 

TEMPI (1 )=TEMI I )  «-R  l  *T  EMI  ( I ) 

552  CONTINUE 

CALL  DCOSPI TEMPI , XI, WB) 

00  553  1=1,3 
WB! I ) =XNOS*WB ( I ) 

553  CONTINUE 
GOIO  1000 

akS 

600  NE*4 

!WH=MASTER!LOATA) 

IN0W=lWHf8 
IEND= IWH+B*20*NE 
00  610  1=1,3 
I  JK=!WH  + 1 *4 

ARSTP! I )=ASTER!l JK)  111 


CALC  420 
CALC  430 
CALC  431 
CALC  432 
CALC  433 
CALC  434 
CALC  435 
CALC  436 
CALC  437 
CALC  438 
CALC  430 
CALC  440 
CALC  441 
CALC  442 
CALC  443 
CALC  444 
CALC  445 
CALC  446 
CALC  447 
CALC  448 
CALC  440 
CALC  450 
CALC  451 
CALC  452 
CALC  453 
CALC  454 
CALC  455 
CALC  456 
CALC  457 
CALC  458 
CALC  459 
CALC  460 
CALC  461 
CALC  462 
CALC  463 
CALC  464 
CALC  A65 
CALC  466 
CALC  467 
CALC  468 
CALC  469 
CALC  470 
CALC  471 
CALC  472 
CALC  473 
CALC  474 
CALC  475 
CALC  476 
CALC  477 
CALC  478 
CALC  479 
CALC  480 
CALC  481 
CALC  482 
CALC  483 
CALC  484 
CALC  485 
CALC  486 
CALC  487 
CALC  488 


610 

CONTINUE 

CALC  489 

cr«dv=xof  sr  (  aksti’, xi ) 

CALC  490 

6?  0 

iHAUMorRAv-ds reau now)  )  .gi.i.oe-ozjgoto  640 

CALC  491 

1)0  6'iO  1=1,3 

CALC  492 

lJK*INOw»I 

CALC  493 

Will  l  1  =  A  S  1 1:  H  (  !  JK) 

CALC  494 

630 

CONTINUE 

CALC  495 

CALL  UNIT(WtS) 

CALC  496 

GOTO  1000 

CALC  497 

C 

CALC  498 

640 

1  Nuw= 1 NOWf NE 

CALC  49° 

IF ( 1  FND.GT . INOW) GOTO  620 

CALC  500 

WHITE  16,003) 

CALC  501 

STOP 

CALC  502 

C 

CALC  503 

C 

COMPUIfc  OULICUITY  ANGLE 

CALC  504 

r 

toMPur  normal  oi st  isn) 

CALC  505 

C 

CALC  506 

1000 

DO  1001  J=  l  ,  3 

CALC  507 

Xii  1  J)=X!  (  J  I+WSIJ  )*1.0E-3 

CALC  508 

1001 

Conti  \an 

CALC  509 

ANGLE =0. 

CALC  510 

11 

00  1002  J= 1 , 3 

CALC  511 

ANGLE  =ANGlE+W»IJ  )*WSl  J) 

CALC  512 

1002 

Coni inul 

CALC  513 

IF ( Aft S ( ANGLE ) . LL . 1 . ) GO  TO  1010 

CALC  514 

ANGLi:  =0  . 

CALC  515 

S  N  =  0 . 

CALC  516 

WRI  Tf:  (6  »904  )NIK , I  I  YPe  ,NBO,  LSUKF  ,  WB,  WS ,  XP ,  XB  ,X  I ,  XNOS 

CALC  517 

I  R  =  N 1 R 

CALC  518 

GO  T U  40 

CALC  519 

C 

CALC  520 

1010 

ANGLE* AT AN2 ( SORT ( 1 .-ANGL E*ANGL E 1 , ANGLE  1  *  180. /3. 141592654 

CALC  521 

IFIANGLc.LE.OO.IGOTO  1020 

CALC  522 

00  1011  J= l , 3 

CALC  523 

WH ( J ) =  -wB{ J ) 

CALC  524 

101 1 

CONTINUE 

CALC  525 

GOTO  1000 

CALC  526 

C 

CALC  527 

1020 

NASC=-2 

CALC  528 

IR=NIR 

CALC  529 

CALL  G  1  (  S 1  ,  I RPRI M»  XP ) 

CALC  530 

$N=S  1 

CALC  531 

GOTO  40 

CALC  532 

END 

CALC  533 

C 

CALC  534 

C 

CALC  535 

C 

CALC  536 

C 

CALC  537 

C 

CALC  538 

SUBROUTINE  TfcSTG 

****  24 

C 

TESTG  2 

C 

TES1G  OPTIONS 

TESTG  3 

C 

TESTG  4 

c 

NRAYS  0  0  TRACE  A  RAY  BETWEEN  TWO  GIVEN  POINTS 

TESTG  5 

c 

X8S  TO  X8F 

TESTG  6 

c 

TESTG  7 

DIMENSION  XP  (  3  )  f.XftFI  3) 

TESTG  8 

COMMON/P AR EM/ X8( 3 ) ,W0(3> , IR 

TESTG  9 

COMMON/GEOM/LHASF,KIN,ROUT,LRI ,LRO,PINF, lERR^OIST 

TESTG  10 

112 


r>  o  o  o 


COMMON/UNCGEM/NRPP,NT5UPtNSCAL,NS0DY,NRMAXtLTftIP,L5CAL,LREGD, 
1  LDATA»LRIN»LR0T»LI0,L0CDA,I15f  130, LBODY,NA$C, K LOOP 
COMMON/WALT/L IRFO,  NGIERR 

901  FORMAT (2110) 

902  FORMAT ( IHO , 22HNUM8ER  OF  SPECIAL  RAYS, 15) 

903  FORMAT (3£15,7,3I15) 

904  FORMAT (1 HO »5H START, 5X,4H  XB*,3E15.7,8H  IRSTRT-,15/ 

1  4H  £ND,7X,4HXBF*,3E15.7,8H  IRFIN*,I5) 

905  FORMAT ( IHO, 3HWB= » 3EI5. ?  * 5X»  6HRANGE*, E15, 7 ) 

906  FORMAT (IHO ,8X , 2H IR,4X,6HIRPRIM, 1 2X, 2HS 1 , 13X , 2HXP , 13X, 2HYP, 

1  13X,2HZP,12X»4HDIST) 

907  F0RMAT(2I10,5X,5£15.7) 

908  FORMAT! IHO, 2 1H TROUBLE  IN  REGION  IR*,I10) 

READ  (5 ,901 ) NRAYS, NGIERR 
WRITE  ( 6  ,902 ) NRAYS 
IFING1ERR.LE.0 )NGIERR=25 

00  50  IRAY=1 , NRAYS 

READ  ( 5 » 903 ) XB , I RSTRT 

READ  (5,903)XbF, IRFIN 

WRITE  (6,904)XB, IRSTRT,XBF, IRFIN 

KANG£=XD IST(XB«X8F) 

CALL  DCOSP(XB,XBF,WB) 

WRITE  (6»905)W8, RANGE 
IR= IRSTRT 
NASC=-I 
WRITE  (6,906) 

10  CALL  G1 l SI, IRPRI M»XP) 

IFdERR.GE.NGlERRJGOTO  60 

WRITE  (6,907) IR, IRPRIM,Sl,XP,DIST 

IFIUIST. GE. RANGE )G0T0  30 

IF (  IRPRIM.LE.0)G0T0  20 

I K  =  I  RPR  I M 

GOTO  10 

20  WRITE  ( 6 ,908  )  I R 
GOTO  50 

30  IFIIR.NE.IRFINJGOTO  20 

50  CONTINUE 

60  I ERR=0 
RETURN 
END. 


SUUROUTINE  VOLUM 

DIMENSION  VASTER ( 1000 ) , WAB( 3 ) , WTB ( 3) , WOB ( 3 ) , DSP ( 3 ) , 

1  XV( 3) , XT( 3 ) ,XA(3),X0(3),XP(3),XTEMP(3) 

COMMON  ASTER ( 30000 ) 

C0MM0N/PAREM/XB( 3),WB(3) ,  IR 

COMMON/GEOM/LBAS  E  ,R!N,ROUT,LRI  ,LR0,P.  INF,  IERR  ,D  I  ST 
COMMON/UNCGEM/NRPP,NTRIP,NSCAL,NBODY,NRMAX,LTRIP,LSCAL,LREGO, 
I  LDATA,LRIN,LR0T,LI0,L0CDA,I15,I30, LB0DY,NASC,KL00P 
C0MM0N/WALT/LIRFQ,NGIERR 
C 

901  FORMAT ( 3E20. 8 )  ,,, 


TESTG  il 
TESTG  12 
TESTG  13 
TESTG  14 
TESTG  15 
TESTG  16 
TESTG  17 
TESTG  18 
TESTG  19 
TESTG  20 
TESTG  21 
TESTG  22 
TESTG  23 
TESTG  24 
TESTG  25 
TESTG  26 
TESTG  27 
TESTG  28 
TESTG  29 
TESTG  30 
TESTG  31 
TESTG  32 
TESTG  33 
TESTG  34 
TESTG  35 
TESTG  36 
TESTG  37 
TESTG  38 
TESTG  39 
TESTG  40 
TESTG  41 
TESTG  42 
TESTG  43 
TESTG  44 
TESTG  45 
TESTG  46 
TESTG  47 
TESTG  48 
TESTG  49 
TESTG  50 
TESTG  51 
TESTG  52 
TESTG  53 
TESTG  54 
TESTG  55 
TESTG  56 
TESTG  57 
TESTG  58 
TESTG  59 
****  25 
VOLUM  2 
VOLUM  3 
VOLUM  4 
VOLUM  5 
VOLUM  6 
VOLUM  7 
VOLUM  8 
VOLUM  9 
VOLUM  10 
VOLUM  11 


902  FORMAT ( 2E20.8) 

903  FORMA  I < IHO, 10x,6HVERTEX, 14X ,6HT0 P.PT , 1 4X , 6HB0T .PT , 14X, 7HSIDE.P TJ 

904  FORMAT ( 4620.8 ) 

905  FORMA l ( 1H0,  8X,1?H0£LTA  ON  TOP ,E 20. 8 , 10X , 10HSI UE  DELTA»E20.8) 

906  FORMAT (2110) 

908  FORMAT C1H0,  2X , 1 P.HSTART TNG  REGION  IS, 15) 

909  FORMAT  I IHO, 16HVASTER  OVERWRITE, 5X,6HNRMAX=, 15) 

910  FORMA  T  (  I  10.E20.B  ) 

911  FORMAT!  IHO.HHDAD  CARD/ I  10,620.8,  I4H  NOT  PROCESSED) 

912  FORMAT! 1 (0 , E20 .8 , 5 X, E20. 8 ,5X, E9. 2 ) 

913  FORMAT ( IHO, 5HSUMV=,5X, £20.8} 

REAL)  (5,906)  IK.NGIF.RR 
IF  (Nf,iERR.LE.0)NGl£RR=25 
READ  (5,901 ) ( XV(  1  )  ,1=1,3) 

READ  (5,901 )(XT(  I  )  ,1  =  1 ,3) 

READ  { 5,901 )(X0( I), I =1,3) 

Rf AD  (5,901 ) (XA(  I)  , 1  =  1, 3) 

READ  (5,902  )()Ol),DT 
WRITE  (6,903) 

WRITE  (6,904) (  XV  (  J  ) ,  X  T (J) ,XO(J),XA(J) , J= 1 , 3 ) 

WRITE  I  6, 905) 000, DT 
WKIIF  ( 6 ,908 )  I  R 

i f ( nkmax.gt . 2000 (white  (6,909)nrmax 
CALL  OCOSP ( XV , XT ,WT8 ) 

CALL  DCv/SIM  XV, XO  ,W08) 

CALL  OCOSP ( XV, XA»WAB) 

XVOl S=XDIST ( XV, XA) 

TeSTDN=d. 

tlstov=o. 

XItMP( l)=0. 

00  10  1=1, NRMAX 
VASTER! I  )=0. 

10  CONTINUE 
J l K=  l  R 
I R J=  1  R 

N2=Xl)(  S  f  (XV, XO)  / DO  0+1. 

Nl=XniST(XV,XT)/DT+l. 

DO  3G0  J  = 1 , N 2 
DO  100  1=1,3 

dsp ( i )=w  r  3 ( i ) *d  r 

Xt)(  I  )=XV(  (  ) 

W«  f 1 >=WA0< I  ) 

100  CuNTINUL 
S1=0. 

U  =  J(R 

DO  200  I  =  l , N 1 
NASC=- l 

110  CALL  GKSl,  IftPRIM.XP) 

I F ( I  ERR . GF . NG 1  ERR ) GOTO  400 
VASTER (  1R)=VASTER(  IRKSl 
IF (DIST.GE.XVDIS JGOTO  115 
1F( 1RPR(M.LE.0)G0T0  120 
IR  =  IRPR  i  M 
GOTO  119 

115  VASTER! IR)=VASTER( I R )  —  ( 0 1 ST-XVDI S ) 

120  XTEMP ( 1 ) =KB ( 1 ) 

X  TEMP ( 2 ) -WB ( 2 ) 

X  f  E'MP  (  3  )  =  WB  (  3  )  114 


VOLUM  12 
VOLUM  13 
VOLUM  14 
VOLUM  15 
VOLUM  16 
VOLUM  17 
VOLUM  18 
VOLUM  19 
VOLUM  20 
VOLUM  21 
VOLUM  22 
VOLUM  23 
VOLUM  24 
VOLUM  25 
VOLUM  26 
VOLUM  27 
VOLUM  28 
VOLUM  29 
VOLUM  30 
VOLUM  31 
VOLUM  32 
VOLUM  33 
VOLUM  34 
VOLUM  35 
VOLUM  36 
VOLUM  37 
VOLUM  38 
VOlUM  39 
VOLUM  40 
VOLUM  41 
VOLUM  42 
VOLUM  43 
VOLUM  44 
VOLUM  45 
VOLUM  46 
VOLUM  47 
VOLUM  48 
VOLUM  49 
VOLUM  50 
VOLUM  51 
VOLUM  52 
VOLUM  53 
VOLUM  54 
VOLUM  55 
VOLUM  56 
VOLUM  57 
VOLUM  58 
VOLUM  59 
VOLUM  60 
VOLUM  61 
VOLUM  62 
VOLUM  63 
VOLUM  64 
VOLUM  65 
VOLUM  66 
VOLUM  67 
VOLUM  68 
VOLUM  69 
VOLUM  70 
VOLUM  71 


VOLUM  72 

IR=J1R 

VOLUM  73 

TESTON=TESTDN-DT 

VOLUM  74 

IFITESTDN.GT.O.JGOTO  180 

VOLUM  75 

WB(l)=WTBtn 

VOLUM  76 

WB(2)=WTBI2) 

VOLUM  77 

WB I  3 ) =WT B<  3 ) 

VOLUM  7B 

NASC=-1 

VOLUM  79 

CALL  Gil  SI , IRPRl M»XP ) 

VOLUM  80 

IF( !  ERR. GE.NG1 ERR) GOTO  400 

VOLUM  91 

1F( Sl-DT )130,160,170 

VOLUM  82 

130  IR=IRPR1M 

VOLUM  83 

J I R= I R 

VOLUM  84 

CALL  GUS1.IRPRIM.XP) 

VOLUM  85 

IF( lERR.GE.NGlERRiGOTO  400 

VOLUM  86 

IF (UlST-DT)  140,160,170 

VOLUM  87 

140  IF( IRPRIM) 150,210, 130 

VOLUM  88 

150  STOP 

VOLUM  89 

160  IR=1RPRIM 

VOLUM  90 

JIR=IR 

VOLUM  91 

L70  TEST0N=S1 

VOLUM  92 

180  00  190  J I  =  1 »  3 

VOLUM  93 

WB  (  J  t ) =XTEMP I Jl ) 

VOLUM  94 

XBIJI )  =  X  0 ( J I J+OSPCJI ) 

VOLUM  95 

190  CONTINUE 

VOLUM  96 

200  CONTINUE 

VOLUM  97 

ONE  PLANE  DONE  -  MOVE  IN  FOR  NEXT  PLANE  IN  LINE 

VOLUM  98 
VOLUM  99 
V0LUM100 

210  NASC=-1 

VOLUM 101 

00  220  1=1,3 

V0LUM102 

WBUUWOBU) 

V0LUM103 

XBU)=XVU> 

V0LUM104 

220  CONTINUE 

V0LUM1 05 

JIR=IRJ 

VOLUMlOb 

IR=JIR 

V0LUM107 

TESTDN=0. 

V0LUM108 

TUSTOV=TtSTOV-DOD 

V0LUM109 

IF( TESTQV1230, 230,280 

V0LUM1 10 

230  CALL  GKSl.IRPRtM.XP) 

V0LUM111 

IFIIERR.GE.NGIERRJGOTO  400 

VOLUM 112 

IF (Sl-DOD) 240, 260,270 

V0LUM113 

240  IR=IRPRIM 

V0LUM1 14 

IRJ=IK 

V0LUM1 15 

CALL  GHS1.IRPRIM.XP) 

V0LUM116 

IFIIERR.GE.NGIERRJGOTO  400 

V0LUM117 

IFIOIST-OOO 1250,260, 270 

V0LUM1 18 

250  IFI  IRPRIM) 150,400,230 

V0LUM1 19 

260  IR=IRPRIM 

VOLUM 120 

IRJ=IK 

V0LUM121 

270  TESTOV=S 1 

V0LUM122 

280  DO  290  1=1.3 

VOLUMl 23 

XAU)=XA(  I)+W0BtI)*00O 

V0LUM124 

XVI  I)=XV(  D+WOBI  I)  *000 

V0LUM125 

XT ( I )=XT ( I )+W0B( I ) *000 

V0LUM126 

290  CONTINUE 

V0LUM127 

JIR=IR 

V0LUM128 

300  CONTINUE 

V0LUM129 

c 

V0LUM130 

C  VOLUMES  COMPUTED 

V0LUM13 1 

15 


oooo  rs  0000 


400  KPAO  (S.010) IR1, VR 

i  F  !  1 fcRrt . G£ .NG  IEKR  )  CO  TO  500 
IF < I  HI .LP.O) |Kl=NRKAX*l 
SUKV=0. 

C 

1-J  4  5 1'  l-l.NKMAX 
VASTER! I )s VASTER ( I ) *000*01 
I F (  I  — ! K  L 1410,430,420 
410  WIUTF  to,910) I .VASTFKII) 

GOTO  44o 

420  'nl<  I  IF  (0,91  l)  HU  ,  VK 
KLAO  (5,910) I R l»  VK 
ooro  At  ) 

C  VOLUME  KH’LACEKENf 

430  XP£i<C=  100.*  (VASTER!  (  J/VR-1.  ) 

Will  f  L  (0,912)  1  .VASTER!  n  ,VR,XPtKC 
VASTLr!  1  )=VK 
KhAU  (5,910) I K l »  VR 
440  SUMV=SU-"V*-VA$  1  DU  1) 

450  CONTINUE 

WRITE  ( o,9l 3) SUM V 
500  1 lKK=o 
Kb  TORN 
LNO 


SUPR'HJT  |  .ML  AREA 

1)1  ML  MS  1 ON  Xl>  {  3  )  ,  WP  (  3  >  ,  XBS  I  3 ) ,C0NVR T{  4,  4 )  ,TYPEUNl4) 

COMMON  A S I FR ( 3C0C0 ) 

COMMON/ P  AKCM /XB ( 3)  ,WB<3)  ,  IR 
COMMON/ U OM/L»ASfc,RIN,ROUT,LRI , LRO.PINF , IERR.UIST 
COMMON/UNCGfcM/ NK  PP ,N  TK I P , NS  CAL , NBODY ,NRMAX, LTRIP»LSCAL,LREGD, 
l  LOAIA,  LRIN.LRol  ,  L I  0,  LOCL'A  ,  1 1 5,  I30,L00DY,NASC,KL00P 
COMMON /C  AL/NIR,$lN,ANGLE»NTYPE«SSPACE»l,XS(3)»WS(3), 

1  TRAVEL, SN,V,H, IV1H 
COMMON/ WAL T/LIRF0,NG1ERR 
COMMON/C  El L/CELS  I  /. 
common/lngeom/llgeom 

901  FORMAT ( l 1 10.6X.2A2  ) 

902  FORMAT (6E 12. 8! 

908  FORMAT! 1H0 , 22HM£ MORY  OVERLAP  IN  AREA, 5X , 7HLEGE0M=, Ifc, 

1  5X  ,  6HLAREA  =  ,  I6,5X,6llLlKF0=,I6) 

909  FORMAT ( l HO, 13H ERROR  IN  AREA.5X , 9HIC0DE  =0) 

910  FORMAT! 1  HO , 8H AZ I  MU TH  = , F 1 0 . 3 , 5X , 10HEL EVA l I0N=,F10.3) 

911  FORMAT! IHO, 12HCELL  SIZE  I S, F4. i , IX, IHX , F4. 1 1 1 X , A2, 1H. , 10X, 

1  12HAREAS  IN  SQ., IX.A2.1H.) 

912  FORMA T ( 1  HO , 5H I CODE , 19X , 4HAREA/ ) 

913  FORMAT! 15, 15X.F12.5) 

914  FORMAT! IHO, 15HPREStNTE0  AREA=»F12.5) 

915  FORMAT! IHO, 18HNUMBER  OF  CELLS  IS,I5,10X, 

1  22HMUMBER  OF  CELLS  HIT  IS*  15} 

IN* l  F  T=2  CM=3  M=4 

1  SO.  M.  =  39.37  *  39.37  SO.  IN. 

OATA  HHIN,HHF l ,HHCM, HHMB , HH08/2H IN ,2HFT , 2HCM , 2HM  ,2H  / 

TYPFUN ( 1 ) =HH 1 N 


V0LUM132 
V0LUM133 
V0LUM134 
V0LUM135 
V0LUM1 36 
V0LIJM1 37 
V01UM138 
V0LUM139 
V0LUM140 
V0LUML41 
V0LUM142 
V0LUM143 
V0LUM144 
V0LUM145 
V0LUM146 
V0LUMI47 
V0LUM148 
V0LUM149 
V0LUM150 
V0LUM151 
VOLUM152 
V0LUM153 
V0LUM1 54 
VOLUME  55 
V0LUM1 56 
V0LUM1 57 
V0LUM158 
V0LUM1 59 
****  26 
AREA  2 
AREA  3 
AREA  4 
AREA  5 
AREA  6 
AREA  7 
AREA  8 
AREA  9 
AREA  10 
AREA  11 
AREA  12 
AREA  13 
AREA  14 
AREA  15 
AREA  16 
AREA  17 
AREA  18 
AREA  19 
AREA  20 
AREA  21 
AREA  22 
AREA  23 
AREA  24 
AREA  25 
AREA  26 
AREA  27 
AREA  28 
AREA  29 
AREA  30 
AREA  31 
AREA  32 


116 


o  o  o 


TYPEUN(2)=HHFT 

AREA 

33 

TYPEUN  (  3  )=HHCR 

AREA 

34 

TYPEUNJ  4 )=HHMB 

AREA 

35 

CONVRT ( 1 , 1  )=1. 

AREA 

36 

CONVRT ( 1 ,2 >=.006944444444444444 

AREA 

37 

CONVRT( 1,31=6.451625806 

AREA 

38 

CONVRT ( 1 ,4 >=.0006451625806 

AREA 

39 

CONVRT (2  » 1 )  =  144. 

AREA 

40 

CONVRT ( 2 , 2 ) =1 . 

AREA 

41 

CONVRT (2, 3 >=929.0341161 

AREA 

42 

CONVRT (2,4 >=.09290341161 

AREA 

43 

CONVRT (3,1 >=.15499969 

AREA 

44 

CONVRT (3, 2 >=.001 076386736 

AREA 

45 

CONVRT ( 3, 3 ) =1. 

AREA 

46 

CONVRT (3,4 ) =.000 1 

AREA 

47 

C0NVRT(4,1 >=1549.9969 

AREA 

48 

CONVRT (4,2 >=10.7636736 

AREA 

49 

CONVRT(4»3)=10000. 

AREA 

50 

CONVRT (4,4)=1. 

AREA 

51 

BLANK=HHBB 

AREA 

52 

AREA 

53 

LAREA=L I RFO- 1000 

AREA 

54 

IFUAREA.GE.LEGEOMIGOTO  10 

AREA 

55 

WRITE  (6,908)LEGE0M,LAREA,LIRF0 

AREA 

56 

STOP 

AREA 

57 

10 

LAR£A1=L IRF0-1 

AREA 

58 

00  20  L=LAREA, IAREA1 

AREA 

59 

ASTERtL  >=0. 

AREA 

60 

20 

CONTINUE 

AREA 

61 

AREA 

62 

READ  ( 5 , 901 ) NX ,NY , IRSTRT  , I ENC ,NG1ERR , NSTART ,NEND,CELLUN, AREAUN 

AREA 

63 

READ  (5,902)A,E,ENGTH,ZSHIFT, GROUND 

AREA 

64 

READ  ( 5 , 902 >XSHIFT,Y SHIFT ,CELS IZ 

AREA 

65 

I F ( IRSTRT  .LE.01 IRSTRT=1 

AREA 

66 

IF ( CELS I Z  .LE.O. )CELSIZ=4. 

AREA 

67 

IF(NSTART.LE.0JNSTART=1 

AREA 

68 

IF(NG1ERR.LE.0)NG1ERR=25 

AREA 

69 

IF ( AREAUN. EQ. BLANK >AREAUN=HHIN 

AREA 

70 

IF (CELLUN.EQ. BLANK >CELLUN*HHIN 

AREA 

71 

DO  30  1=1,4 

AREA 

72 

IF(CELLUN.EQ.TYPEUN( IJJGOTO  40 

AREA 

73 

30 

CONTINUE 

AREA 

74 

40 

00  50  J= 1 , 4 

AREA 

75 

IF(AREAUN.EO.TYPEUN( J) JGOTO  60 

AREA 

76 

50 

CONTINUE 

AREA 

77 

60 

AREA=CSLSI l  *CELSIZ  *CONVRT(I,J) 

AREA 

78 

. 

AREA 

79 

RADI AN=. 0174532925 19943 

AREA 

80 

AR=A*RAOI AN 

AREA 

81 

ER=E*RAOIAN 

AREA 

82 

SA=SIN( AR) 

AREA 

83 

CA=COS ( AR ) 

AREA 

84 

S£=SIN(ER) 

AREA 

85 

CE=COS ( ER ) 

AREA 

86 

KL=NX*NY 

AREA 

87 

NHI T=0 

AREA 

88 

AREA 

89 

PROCESS  KL  CELL’S  IN  GRID 

AREA 

90 

DO  200  KK=NSTART ,KL  117 

AREA 

91 

AREA 

92 

o  no 


I 


OF  GRID  CELL  !N  GRID  PLANE 
+CELL2 


J)*CFLSi;  +CbLL? 


W!H  1  I  A 

Wii(2)--CF<:SA 

hni  a  -~s> 

I  I  =  (  (  Mv-  |  )/,\X  )  t  1 

J  -Nk-  I  i  1  - 1  ) 

»-  (,oo <rr nates 

GL  L12*.  SoCirLS  I  l 
v"f  ' '  ‘ 1  *  f-v/,*)-!  n*uf.LSU 
VKLF  -  V  fCel  L2 

•  < = r  l  o  a  r i <  nx/ 2 ) 

HR(.I  =M»U  L  1.2 
JV-sRiWi-i )  «ic. 

I H-RAN ( -  I i *  10. 
lVlil=lf»*lHHv 

V-MulTM'f  'r'l  AT  KAN00f'  —  -  .«  Ol 

V-V.OLW2  <FL0A  t  (  IVJ/10.+CLLSIZ  /?0. 

"  =  HfULSI/  * F L OA  T (  !H)/lu.+CLLSIZ  /20. 

X,Y,/  IN  LOOKDINAIE  SYSTEM  OF  VEHICLE1 
<PS( l)»ASHIFl-v*CA*SE-H*SA 
rYSKIf  T-V*SA*$F.H»*CA 
XriS (  T ) =/ SHIP  I ♦ v*CL 
GALL  IR.PIC(Wi’) 

XilS  U  )  =X  AS  I  l  )  ¥ V»P  (  1  )*  1  .OF -A 
XtlS  (  ?  )  =  <d$  (  2  )  *W!»  (  2  )  *  1 .  Ot  -4 
XtiS  (3 I  =  XHS{  i  I  ♦  wi>  (  3  )*  1.0E-<, 

Xti  (  1  )  =X(1S  (  l  l-LNG  ) 

XR  (  2  )  =  X‘»S  (  ?  )  -ENG  TH*W8  (  2  ) 

X» (  I )  -XRS (  l )-( MG  TH*WHt  3 ) 

IF(Xh( 3)  .Lc. Groom;) goto  200 

iragi  Ray  to  first  Component  hit 


POINT  IN  GKIO  CELL 


1R= IRS  Ik  I 
N  A  S  C  =  -  1 

110  CALL  Gl ( S 1 f I RPRJ  M, XP  ) 

IF(  I CRR . GC . NG 1  ERR ) RE  TURN 
IF( IRPR1M.LT. l  TC07C  200 
IF (NASC.LE.NRPP) 1*PR IM-O 
IF( IRPRIM.OG.OIGOrO  200 
LOC--L  I  R  I-  0  ♦  1 1<  Hr  |M-l 
GALL  0N2 ( LOG , I  CODE  » I OEN  T I 
I t)EN  T  =  I  Ufc'NT-  1 

IT  (  U'FNf-( I  DENT/ 1 0 ) *  10. E 0.0  I  GO  TO  120 
I R  = I  RPR  I N 

Gu  r  (#  1 1  *  * 

120  IF  (  l  COO):  .  RE  ,0  IGOTO  130 
WRITE  ( (1,009) 

GOTO  20(* 

130  LOC=l ARE A+JCCOE- 1 

ASTER  ( LuC  i  =A5  5  EH.  (  LOC  1  (-ARE  A 
TIM  £  T  =  \H  l  T  ♦  l 
200  CONTINUE 
C 

C  PRINT  Ri.  SUL  IS 
C 

Wktir  I  o ,  9  1 0  )  A  ,  E 

w“!!f  !;,’,1,"iCELSIe'  CELS1Z'  CCLLUH.A„eAUN 
SUMA=0 . 

GO  290  1*1,999  1  j g 


AREA  . 93 
AREA  ' 9A 
AREA  95 
AREA  96 
AREA  97 
AREA  98 
ARC A  99 
AKLA  100 
AREA  101 
AREA  102 
AREA  103 
AREA  l 04 
AREA  L05 
•  AREA  106 
AREA  107 
AREA  108 
AREA  109 
^REA  .110 
AREA  111 
AREA  112 
AREA  113 
AREA  114 
AREA,,  115 
AREA  116 
AREA  11,7 
AREA  118 
AREA  11(9 
AREA  120 
'  AREA  121 
AREA  122 
AREA  123 
AREA  124 
AREA  12.5 
AREA  L?6 
AREA  127 
AREA  128 
AREA  129 
AREA  130 
AREA.  131  f 
AREA  13'2  • 

,  AREA  133 
AREA  134  , 

AREA  135 
AREA  136 
AREA  137 
AREA  130 

Area  139 

AREA  140 
AREA  141 
AREA  142 
AREA  143 
AREA  144  ! 

AREA  145 
AREA  146 
AREA  147 
■  AREA  148 

area’  149 
AREA  150' 
AREA  151 

area  .152 


) 


)  : 


I 


) 


/ 


J 


> 


f 


) 

1 

i 


) 


) 


i 


} 


i  l 


n  n  n  o  o  o  n  n  r.  o  o  n  n  -c.f-.oo 


I 


L0C-LARt‘A+  1-1 

'  lF!ASTER{L0C).EQ.0.)G0T0  250 
WRITE  (6t91'3)  I,  »ASTER  { LOC  J 
SUMA=SUMAVASTER!  LOC)  > 

250  CONTINUE 

WK  I  T£  |  {.6  *  9 14  )  SUM  A  . 

WRITE  ( 6, 9 15  )KL»  NH 1 1  ,  .  i 

:  kH  TURN  ,  •  j  ’ 

END 


.  SUBKOUT  i  NE  tGl!Sl,IR.PRIM,XP) 
MAIN  RAY  TRACKING  ROUTINE 


GIVEN  A  RAY  IN  RtGlON  1R  AT  POINT  XB  WITH  Oi'RECT  ION 

COSINES  WB  t  FIND  THE  DISTANCE  (SI)  TO  THE  NEXT  REGION 
■  AND  I  HE  NUMBER  OF  THAT  REGION  URPRill) 


NASC=-2 
NASC  =  -1. 
IVOt;UM=l 
,  ITLSTG=1 
GIST 


CALL  From  CALC  TO  FIND  NORMAL jOIST 
START  NEW  RAY  ,  ! 

CALL  FROM  VOLUM  » 

CALL  FROM  TESTG 

TOTAL  OIST  TRAVELED  BY  RAY  SO  FAR 


DIMENSION  MASTER ( 30000) ,XP{ 3) * XBO<  3) »LSURt { 50) »NASC  T ( 50 )  ' 

COMMON  ASTER! 30000)  1  1 

COMMON/PAREM/XBI  3)  ,WB('3)  ,  IR 

COMMON/GE'OM/LOASE.KIN.ROUr.tLR!  ,LRO,PINF,  IERR.DIST  , 

COMMON/UNCGEM/NRPP  f  NTR  I P  ,  NSCAL  ,NBODY  , NRMAX, L  TR  I  P»  LSCAl. »  LREGD, 
1  LDATA,  l.RIN,LROT,LIO,LOCDA,  115,  130, LBODY,NASC,XLOOP 
COMMON/C  AL/ ['ll  R  ,  S  1  f|l,  ANGLE  »  NT  Y.PE  ,SSPACE,L,XS(3),WS(3),TKAVEL, 

1  SN,V,H,  IVIlH  ,  • 

COMMON/WALT/LIRFO,NGIERR  ; 

COMMON/LSU/LSURF  1  1  i 

COMMON/CONTRL/I TESTG , I RAYSK , IENTLV, I VOLUM, I  WOT , I  TAPE  8, NO, I  YE S 
COMMON /DA V  IS/ IGR ID ,L00P , I  NORM 

’•  COMMON/CFLL/.CtLSIZ  1  : 

EQUIVALENCE  {ASTER, MASTER)  ,  . 


901  FORMAT(1HO,32HEKROR.  IN  G1  AT  140  BAD  ITYPE,5X,4HITY=, 15) 

902  FORMAU  1H0.33HERR0R  IN  Gl  AT  510  SM  0=  P  INF  ,5X,  3H I  R=  ,  I  5 ), 

903  FORMA  I ( 4H  XB= , 3E20 .8/4H  KB= ,3E20. 8/idX, 5HKE00P, 1 2X , 3HNB0 , 

I  12X , 3HLK l  ,  12X,  3HLR0,il  1 X  ,4HNH  IT  ,  1  IX  »4HL00P/ 6 1 15  )  i  , 

904  FORMA) ( IH1 , 15( 2H*  ),3X,  9HERR0R  NO . . 1 5 , 3X , 15 C2H  *)//> 

905  FORMAT (34X,4HC£LL,2I4)  ’  1 

>906  FORMAT! 19H‘ ERROR  IN  Gl  AT  6.40//4H  Jl  =  ,I10,.4H  J2=,110,7H  LSURF=, 

1  II0.6H  NASC=  ,  1 10, 4H  IR=,  1 10^4H  5M=  fO  1  .  10  i  4H  Sl  =  ,c,17.  10/  , 

2-  4H  t»B=  ,  3E2 1 «  10/4H  XB=,3E21.10)  ■ 

907  FORMATION  THE,  (SOLtO  POS  l  T ION/OEPTH/POI  NT  NOW  AT)  IS  ONE  OF, 

1  faH  THUSf:/6H  XBO  =,3E21.10/6H  0  I  ST= ,  E2 1 . 10// )  ■ 

908  FORMA T,(9X,3HR IN, 12X, 4HR0UT , 7X, 8HENTER ING , 2X, 7HLE AV ING, 3X , 
l  8HB0DY  NO. , 5X»  3HRAY, /35X,  8HS  IDE  NO*.  ,  2X  ,  8HS  IDE  NO.//) 

910  FORMAT ! //16H  TILT  R IN=ROUT  =  , E20 . 10 , 30X , 2HIf *  I  5// )  , 

911  FORMAT  (  2  (  2X,  L  151.  8  I  »4X,  1 2 , 8X  »]1 2 ,6X,  15 , 5X,  7HS T ARTEO/  ) 

912  FORMAU2i2X,E15.8)  ,4X,12,8X,  12, 6X,  I5,5X,7HHAS  HIT/) 

913  FORMA  T(2(2X,|E15.B)',4X,I2,8X,I2,6X,I5,5X,7HLEAV  ING/  ) 

914  F0RMAT!2!2X,El5.^),4X,I2,8X-,12,6X',I5,5X,7Fi  IN  /) 


ARFA 

153 

AREA 

154 

AREA 

155 

AREA 

>156 

AREA 

157 

AREA 

‘  1 5fi 

AREA 

1  59 

AREA 

1,60 

AREA 

161 

AREA 

162 

ARtA 

163 

AREA 

164 

AREA 

165 

**** 

27 

Gl 

,  2 

Gl 

‘  -3 

Gl 

4 

Gl  , 

•  5 

Gl  ‘ 

b 

Gl 

7 

Gl- 

ft 

(il 

9 

Gl 

‘  10 

Gl 

11 

Gl 

12 

1  G 1 

!  13 

Gl. 

14 

■  Gl 

15 

Gl 

16 

Gl 

17 

Gl 

18 

61 

i9' 

Gl 

!  20 

Gl 

21 

Gl 

2? 

Gl 

23 

Gl' 

24 

Gl 

25. 

Gl 

:  26 

Gl 

21 

Gl 

28 

Gl 

29 

Gl 

30 

Gl 

’31 

Gl 

32 

Gl 

33 

Gl 

34 

Gl  ’ 

35 

Gl 

36 

Gl 

37 

Gl 

38 

Gl 

.  39 

Gl  . 

’  40 

,G1 

41 

Gl 

42 

Gl 

43 

,  Gl  ’ 

44 

Gl 

45 

Gl 

46 

Gl 

4  7 

I 


i 


J  O  O  >->  O  O 


015  P0KMAT(2(2X,E15.8> ,4X , 1 2 , 6X , 12 ,6 X, 15 ,5X , 8HENTEK ING/ ) 
916  F0RMAT(2(2X,£15.a)  ,AX,  U  8X,I2,6X,I5»5X,  8HW  ILL  HIT/) 
017  FORMAT I//4I IAH  END  ERROR  N0,,J4,3X)/) 

018  FORMAT  (1110, 15, 21H  ERRORS  IN  Gl,  RETURN) 

I  NO«M-»0 

IF (NASC. 60.-2 ) INORM= 1 
S  l  =0. 

lETNASC.GT.OlGOTO  20 
HEW  KAY 
0IST=O. 

IF  I  KL00P.LT. 32000 ) GO  TO  15 
KL00f’  =  0 

L  I  ON-  L  I  O  »MBOI)Y  >MRPP~  1 
00  10  I  =  LI  0 , 1. 1  ON 
MAS  I  PR  I l ) =0 
10  CON  f  I  *il)F 
15  K l OOP- K LOOP ♦ 1 

BEGIN  TRACING  RAY 


20  jMsp IMF 
NHIT'-O 

LOC-L  REGD+  IK-  1 
CALL  UN 2 ( LOG , LOG ,NC ) 
LOC.-U  C-l 


,  NO MUM  OF  BODIES  IN  REGION  DESCRIPTION 

C  FIND  RIM  AND  ROUT  FOR  EACH  OF  THESE  BODIES 

c  KIN  IS  0 1  ST  From  X8  TO  POINT  WHERE  KAY  ENTERS  THE  BODY 

ROUT  IS  0 1  ST  FROM  XB  TO  POINT  WHERE  RAY  LEAVES  THE  RODY 
IF  ROUT  =  -PINE  RAY  OOES  NOT  HIT  BODY 
Gl  SELECTS  SMALLEST  OF  RIN  AND  ROUT  DISTANCES  0  DIST 
11  UNIQUE  RIN  VALUE  -  NEXT  GODY  IN  PATH  OF  RAY 
2)  2  OR  MORE  RIN  VALUES  -  2  OR  MORE  BODIES  HAVE 

A  COMMON  SURFACE 

31  ROUT  FOR  CURRENT  BODY  MFANS  RAY  WILL  LEAVE 
THIS  BODY  BEFORE  ENCOUNTERING  ANOTHER 


C 


DO  500  fl  =  I ,  NC 
L  ~‘C  -l  iCH 

CALL  UN2 ( LOG , UUM , NBO 1 

I  I EMP  =  L I O  +  NBO- l 

CALL  UNO ( I TfcMP.LRI  ,LRO ,LOOP 1 

I  TcMP-L!)OOYf3‘>  (NBO-1  ) 

CALL  UN2(  I  I EMP, I  TYPE , LOCOA) 

IE ( LOOP . ME • KLOOP (GOTO  130 

CONTINUATION  OF  RAY 
[Ft  I TYPE.GT. 111G0T0  140 
I  JK  =  LKl'l*NBO-l 
R I N=  ASTER ( I JK 1 
I  JK  =  LROT  +N80-1 
kOUI=ASTGK( IJK) 

I  E I  ITYPL.LT.  IGJGOTC  320 

[OR  AMD  ARS 

IE  0 1 S  T  .GE.  ROUT  COMPUTE  RIM  /  ROUT  SET 
IE(ROUT.LT. 0. 1G0T0  320 
IMulST.LT. ROG i ) GOTO  320 
I P 1NASC. EO.NBO )NASC=0 


Gl 

48 

G.l 

Gl 

56 

Gl 

51 

Gl 

• 

Gl 

.  ; 

Gl 

3s 

Gl 

Sv> 

Gl 

56 

GJ 

' 

Gl 

>  8 

Gl 

50 

Gl 

60 

Gl 

61 

Gl 

62 

Gl 

63 

Gl 

64 

Gl 

a  5 

GL 

6o 

Gl 

6  i 

Gl 

6o 

Gl 

69 

01 

70 

Gl 

71 

Gl 

7? 

Gl 

73 

Gl 

74 

Gl 

75 

GL 

76 

GL 

77 

Gl 

78 

GL 

79 

Gl 

80 

GL 

3! 

Gl 

82 

Gl 

83 

Gl 

8s 

Gl 

85 

Gl 

86 

Gl 

37 

Gl 

88 

Gl 

89 

Gl 

90 

Gl 

9) 

Gl 

92 

Gl 

,  93 

Gl 

96 

Gl 

95 

Gl 

96 

Gl 

97 

Gl 

98 

Gl 

99 

Gl 

I0O 

Gl 

101 

GL 

102 

Gl 

103 

Gl 

104 

Gl 

105 

Gl 

106 

Gl 

10? 

12C 


c 

c 


c 

c 

c 

c 


130  LRl  =  l 
LR0=l 

I T  Y  =  I TYPE+  1 

IF  I I T Y .GE . 1 » ANO. ITY.LE.12)GOiO  200 
140  IERR*IERR4-1 

WRITE  (6,901 )  1  TYPE 
GOTO  800 

RPR  BOX  SPH  RCC  REC  IRC  ELL  RAW  ARB  TEC  TOR  ARS 
200  GOTO (205, 2 10, 2 15, 220, 225, 230, 235, 240, 245, 250, 255, 260),  I  TY 
205  CALL  RPP(NSO) 

GOTO  300 
210  CALL  ROX 
GOTO  300 
215  CALL  SPH 
GOTO  300 
220  CALL  RCC 
GOTO  300 
225  CALL  REC 
GOTO  300 
230  CALL  TRC 
GOTO  30U 
235  CALL  ELL 
GOTO  300 
240  CALL  RAW 
GOTO  300 
245  CALL  ARB 
GOTO  30u 
250  CALL  TEC 
GOTO  300 
255  CALL  TOR 
GOTO  300 
260  CALL  ARS 

300  IJK=LKl-N+NBO-l 
ASTER! I  JK ) =rt I N 
I JK=LROT  +NB0-1 
ASTER ( I JK ) =ROUT 
I  JK=L IO+NBO- 1 

MASTER (I JK)=KL00P+I15*(LR0+64*LRI ) 

320  IF ( NASC . ME .NBQ )GOTO  330 
IF(L$URF  >500,500,340 

330  IFUOUT.LE.O.  )GOTO  500 
IF (KIN.GT.O. )GOTO  350 


340  I F  I  AP,S(R0UT-SM).GT.SM*1.0E-6)GQT0  341 
ROUT=SM 

I JK=LROT+NBO-i 
ASTER ( I JK ) =  ROUT 
GOTO  345 

341  I F ( ROUT-SM ) 342 ,345 ,500 

342  IF ( DI ST. GE .ROUT ) GOTO  500 
NH I T=0 

345  NHITsNHJT+I 
SM=ROUT 

LSURTINHI T )=-LRO 
MASC1 (NHIT)-MBO 


G 1  10H 
G 1  109 

G1  110 
G 1  111 

G 1  112 

G1  113 
G 1  114 

G 1  115 

Gl  116 
Gl  117 
G 1  118 

Gl  119 
Gl  120 
Gl  121 
Gl  122 
Gl  123 
Gl  124 
Gl  125 
Gl  126 
Gl  127 
Gl  128 
Gl  129 
Gl  130 
Gl  131 
Gl  132 
Gl  133 
Gl  134 
Gl  135 
Gl  136 
Gl  137 
Gl  138 
Gl  139 
Gl  140 
Gl  141 
Gl  142 
Gl  143 
Gl  144 
Gl  145 
Gl  146 
Gl  147 
Gl  148 
Gl  149 
Gl  150 
Gl  151 
Gl  152 
Gl  153 
Gl  154 
Gl  155 
Gl  156 
Gl  157 
Gl  158 
Gl  159 
Gl  160 
Gl  161 
Gl  162 
Gl  163 
Gl  164 
Gl  165 
Gl  166 
Gl  167 


121 


o  o  non 


351 


G1 

168 

1 F  C  ABS(RIN-SM)  .GT. SM*l .OE-6 IGOTO  351 

Gl 

169 

KlN=SM 

Gl 

170 

t JK=LKIN+N80-l 

Gl 

171 

ASTCR (1 JK) =R 1 N 

Gl 

172 

GOTO  355 

Gl 

173 

IF(RiN-SM) 352,355,500 

Gl 

174 

If (DIST.Gb.RlN)GOTO  340 

GL 

175 

NH l T  =  0 

Gl 

176 

NH I r  =NH I T ♦ 1 

Gl 

177 

SM=kIN 

Gl 

178 

LSURT { NH IT) =LR1 

Gl 

179 

NASC  T I NH  I  T )  =  NflO 

Gl 

180 

Gl 

181 

CONTINUE 

Gl 

182 

Gl 

183 

SM.GE.PINF  ERROR  AT  510  IN  G1 

Gl 

184 

Gl 

185 

I F ( SM.L  T .P  INF ) GOTO  530 

Gl 

186 

WRITE  1 6 ,902 ) l R 

Gl 

187 

WR1  TF  I6»903)X8* WB ,KLOOP , N80, LRI ,LRO,NHI T,L00P 

Gl 

188 

GOTO  700 

Gl 

189 

Gl 

190 

S1  =  S  1  +  SM-OI ST 

Gl 

191 

01 ST=SM 

Gl 

192 

XP( l >=X8(  1 )+SM*Wfi!  11 

Gl 

193 

XP  ( 2  )  =  Xb  I  2  )  *’SR*WB(  2 1 

Gl 

194 

XP(3)=X»(3)+SK*W8I 3) 

Gl 

195 

Gl 

196 

IFI-NASC.E0.-2)  RE  TURN 

Gl 

197 

Gl 

198 

UNO  NEXT  REGION  (I  RPR  I  Mi 

Gl 

199 

Gl 

200 

00  6 A  0  NM= 1 , NH I T 

Gl 

201 

NASC  =NAStT(NN) 

Gl 

202 

LSURF=LSURT INN) 

Gl 

203 

LTKUE=0 

Gl 

204 

L0C=L80DY*3*(NASC-l) 

Gl 

205 

L0C=L0C+  1 

Gl 

206 

CALL  UN2 (LOG, LENT, LEAV) 

Gl 

207 

LQC=LGC+  1 

Gl 

208 

CALL  UN2 ( LOC ,NEN T, NE AV ) 

Gl 

209 

IF(LSURF.LE.O)GOTO  600 

Gl 

210 

J1=LENT 

Gl 

211 

J2=LENT+NENT-1 

Gl 

212 

GOTO  610 

Gl 

213 

J1=LE AV 

Gl 

214 

J2  =  LLAV+NE'AV-1 

Gl 

215 

Gl 

216 

IRPRIM=MASTER( J2  ) 

Gl 

217 

IFIJL.LE.J2 (GOTO  620 

Gl 

218 

1 F ( NASC .GT .NR PP) GOTO  700 

Gl 

2  19 

I F { LSURF )630 , 700 , 700 

Gl 

220 

Gl 

221 

l  00  625  J=J 1 , J2 

Gl 

222 

IRPRIM=MASTERl J) 

Gl 

223 

CALL  WOW  I ( I  RPR IM, LSURF, NASC, LTKUE) 

Gl 

224 

IFILTRUfc.GT.OlGOTO  650 

Gl 

225 

i  CONTINUE 

G 1 

226 

122 

Gl 

227 

O  <-!  o  O  O  O 


L 

c 


c 


c 


c 


RPP  CHECK 

Gi 

228 

GL 

229 

lP(NASC.GT.NRPP)f.0I0  640 

Gl 

230 

IFILSURT  16  30,700,640 

GI 

231 

630 

CALL  KPP2(LSUKF,XP,!RP) 

GI 

232 

1 F ( I RP.G  T.O ICO  TO  631 

Gl 

233 

1 KPR ( M=0 

Gl 

234 

Kl  TURN 

Gl 

235 

Gl 

236 

631 

LTKUP=0 

Gl 

237 

L0C-LB0DY+  3* (  IRP-  l 1 

Gl 

238 

L0C=L0C+ 1 

Gl 

239 

CALL  UN2 ( LOC  » L  cN  T , L£  AV 1 

Gl 

240 

LOC=LOC* l 

Gl 

241 

CALL  UN2  (LOC, MEN T ,  NEAV  1 

Gl 

242 

J  1-LENT 

Gl 

243 

J2=LENT+NFNT-1 

Gl 

244 

IF ( J1  .G T . J2  1G0T0  700 

Gl 

245 

Gl 

246 

00  632  J=Jl,J? 

Gl 

247 

IRPR |M=MASTLR( J) 

Gl 

248 

CALL  WOWI { IKPRIM,LSURF,1RP,LTRUE 1 

Gl 

249 

IFtLlKUF.GT.OtGOTO  650 

Gl 

250 

632 

CONT 1 NUc 

Gl 

251 

Gl 

252 

640 

CONTI NUt 

Gl 

253 

GOTO  700 

Gl 

254 

Gl 

255 

NtXi  REGION  (IRPRIM1  HAS  BEEN  DETERMINED 

Gl 

256 

Gl 

257 

650 

1F(  IR.EQ.1RPKIM1G0T0  660 

Gl 

258 

IF ( Sl.EQ.O. 1G0T0  660 

Gl 

259 

IFISI.LT. 0. 1G0T0  700 

Gl 

260 

IF(ABS(S1).LE.1.0E-6)G0T0  660 

Gl 

261 

I F ( I VOLUK. EC. 1  YE  S ) RE  TURN 

Gl 

262 

I F (  ITESTG.EQ.IYES1RE  TUP,?. 

Gl 

263 

L0C=L I RFO+ I R- I 

Gl 

264 

CALL  UN2(L0C,IC00E,IDENT) 

Gl 

265 

L0C=L1RF0+IRPRIM-1 

Gl 

266 

CALL  UN? ( LOC, I CODE  1, I DENT  1 ) 

Gl 

267 

IF!  ICENT.EQ.11G0T0  655 

Gl 

268 

I F (  IOENI .E0.IDENTI1G0T0  660 

Gl 

269 

RETURN 

Gl 

270 

655 

IF (  ICODE.NE. IC00F1 (RETURN 

Gl 

271 

660 

IR=IRPR!K 

Gi 

272 

GOTO  20 

Gl 

273 

Gl 

274 

DIAGNOSTIC  ERROR  PRINT 

Gl 

275 

Gl 

276 

700 

IERR=IERR+1 

Gl 

277 

WRITE  ( 6 ,904 1 l ERR 

Gl 

278 

IF IIVOLUM.EC. lYES.OR.ITESTG.EO.IYESIGOTO  705 

Gl 

279 

IH=ABS(H/CELSIZ  1+.5 

Gl 

280 

I F ( H.LT.O. 1 IH=-IH 

Gl 

281 

IV=ABS(V/CELSIZ  J+.5 

Gl 

282 

IFIV.LT.O. 1IV=-IV 

Gl 

283 

WRITE  ( 6 ,905 1 IH, I V 

Gl 

284 

705 

WRITE  (6,906) J1,J2,LSURF,NASC, IR , SM, S 1 , WB,XB 

Gl 

285 

XBD(  1  >  =  Xt3  (  Il-DIST 

Gi 

286 

XB0(2)=XR<  21-DIST 

Gl 

287 

/ 
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xao ( 3 ) =X8 ( 3 l-D I S  T 

write  (6,907) xbd ,  o  i  s  r 

wRNfc  (6,908) 

NN=NB00Y+NRPP 

c 

00  750  1=1, NN 
L0C=L 10* I-l 

CALL  UN3 ( LOC , 1 1 ,  12,13) 

1F(KL00P.NE.I3)G0T0  f 50 
l JK  =LR  IN+I-l 
R I N= AS  TER ( IJK) 
lJK=LKOr+l-l 
rtOUT=ASTFR ( I JK) 

IF  (RIN.NE.ROUT)GOTO  710 
WRITE  (6 ,9 10 )R  IN ,  I 
GOTO  750 
C 

710  IF(ARS(KIN).N£.PINF)G0T0  720 
I F ( ABS ( ROUT )-P INF ) 790, 750,790 
720  I  F  (  R  I N-li  1ST)7  30, 799,795 
730  1F(K0UT-0IST)791 ,742,743 

C 

790  WRITE  (6, 9ll)R IN, ROUT, 11,12,1 
GOTO  750 

791  WRITE  ( 6 , 912 ) R IN, ROUT, 11,12,1 
GO  I  0  750 

792  WRITE  (6, 913)RIN, ROUT, 11,12,1 
GOTO  750 

793  WRITE  (6, 919) R IN, ROUT, II, 12, I 
GOTO  750 

799  WRITE  (6,915)RIN,R0UT,I1, 12,1 
GOTO  750 

795  WRITE  (6,916)RIN,R0UT,I1,I2,I 

C 

750  CONTINUE 

WRITE  (fa, 917)1  ERR, I E  RR , IERR,IERR 
I  RPR  I M=- 1 
C 

800  1F( IERR.GE.NG1 ERR) WRITE  ( 6, 918 ING1ERR 
RETURN 

END 

C 

C 

SUBROUTINE  WOW  I ( JREG,LSURF,NEX,L TRUE ) 

GIVEN  A  POINT  (XB)  AND  A  REGION  ( JREG) ,  DOES  XB 
LIE  WITHIN  JREG 

SUFFICIENT  CONDITION  FOR  POINT  XB  TO  BE  IN  REGION 
JREG,  IS  THAT  REGION  DESCRIPTION  OF  JREG  BE 
SATISFIED.  TWO  REGIONS  CANNOT  BE  SATISFIED  FOR 
THE  SAME  POINT 

♦  OPERATOR  VALID  IF  ROUT.GT.O  AND  RIN.LE.DI ST.LT.ROUT 
-  OPERATOR  VALID  IF  ROUT.LE.O  OR  DIST.LT.RIN  OR  DIST.GE.ROUT 
OR  OPERATOR  VALID  IF  ALL  («■)  AND  (-1  IN  (OR)  STATEMENT  VALID 

REGION  DESCRIPTION  WITH  1  OR  MORE  (OR }  STATEMENTS  VALID 
IF  ANY  ONE  OF  (OR)  STATEMENTS  IS  VALID 
REGION  DESCRIPTION  WITH  NO  (OR)  STATEMENTS  IS  VALID  ONLY 


Gl 

286 

Gi 

289 

Gl 

290 

Gl 

291 

Gl 

292 

Gl 

293 

Gl 

299 

Gi 

295 

Gl 

296 

Gl 

297 

Gl 

298 

Gl 

299 

Gl 

300 

Gl 

301 

Gl 

302 

Gl 

303 

Gl 

309 

Gl 

305 

Gl 

306 

Gl 

307 

Gl 

308 

Gl 

309 

Gl 

310 

Gl 

311 

Gl 

312 

Gl 

313 

Gl 

319 

Gi 

315 

Gl 

316 

Gl 

317 

Gl 

318 

Gl  • 

319 

Gl 

320 

Gl 

321 

Gl 

322 

Gl 

323 

Gl 

329 

Gl 

325 

Gl 

326 

Gl 

327 

Gl 

328 

Gl 

329 

Gl 

330 

**** 

28 

WOWI  2 
WOWI  3 
WOWI  9 
WOWI  5 
WOWI  6 
WOWI  7 
WOWI  8 
WOWI  9 
WOWI  10 
WOWI  11 
WOWI  12 
WOWI  13 
WOWI  19 
WOWI  15 
WOWI  16 
WOWI  17 


124 
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C  IF  EVERY  (+)  AND  (-J  OPERATOR  IS  VALID 

C 

DIMENSION  MASTER  130000) 

COMMON  ASTER! 30000) 

COMMON/P AREM/XBI 3) ,WB( 3) ,  IR 

COMMON/GEOM/LBAS E, KIN, ROUT, LRI,LRO,P INF, IERR,DIST 
COMMON/UNCGEM/NRPP,NTRIP,NSCAL ,NBODY»NRHAX»LTRIP»LSCAL»LREGD» 
1  LDATA,LRIN,LROTfLlO,LUCOA,I15,I30»LBODY,NASC,KLOOP 
EQUIVALENCE (ASTER, MASTER) 

C 

901  FORMAT! IH0,32HERR0R  IN  G1  AT  140  BAD  ITYPE, 5X, 4HITY  =  , 1 5) 

C 

LOC=LREGO+J REG-1 
CALL  UN2 ( LOC , LOCO, NC ) 

CALL  UN2(L0CD,I0P,NB0) 

N=  I 

IOPER=IOP 


EXAMINE  NC  CHOICES  N=1,NC 


C 


C 

C 

C 


C 


10  ITEMP=H0  +  NB0-1 

CALL  UN3 (ITEMP»LRI,LRO,LOOP) 
ITEMP=LB0DY-*-3*(NB0-l) 

CALL  UN2 ( ITEMP,ITYPE,LOCDA) 

IF ( LOOP.ME.KLOOP  JGOTO  30 
CONTINUATION  OF  RAY 
IF(ITYPE.GT.U)GOTO  40 
1 JK=LRIN+NBO-l 
RIN=AST.ER(  UK) 

I JK=LROI +NB0-1 
rtOUT=ASTER( IJK) 

IF(ITYPE.LT.10)G0T0  310 
TOR  AND  ARS 

IF  DIST  0  ROUT  COMPUT  RIN/ROUT  SET 
IFUOUT.LT. 0.  JGOTO  400 
IF(OIST.LE.ROUT)GOTO  310 


30  LK1=1 

lro=  i 

ITY=ITYPE+1 

IF!  ITY.GE. l.AND. ITY.LE.12)G0T0  100 
40  IERR= IERR+ 1 

WRITE  (6,901) I  TYPE 
RETURN 

RPP  BOX  SPH  RCC  REC  TRC  ELL  RAW  ARB  TEC  TOR  ARS 


100 

GOTO! 110, 120, 

110 

CALL 

RPP 1 NBO ) 

GOTO 

300 

120 

CALL 

BOX 

GOTO 

300 

130 

CALL 

SPH 

GOTO 

300 

140 

CALL 

RCC 

GOTO 

300 

150 

CALL 

REC 

GOTO 

300 

160 

CALL 

TRC 

GOTO 

300 

1T0 

CALL 

ELL 

GOTO 

300 

WOWI 

18 

WOWI 

19 

WOWI 

20 

WOWI 

21 

WOWI 

22 

WOWI 

23 

WOWI 

24 

WOW! 

25 

wowi 

26 

WOWI 

27 

WOWI 

28 

WOWI 

29 

WOWI 

30 

WOWI 

3  L 

WOW! 

32 

WOW! 

33 

WOWI 

34 

WOWI 

35 

WOWI 

36 

WOWI 

37 

WOWI 

38 

WOWI 

39 

WOWI 

40 

WOWI 

41 

WOWi 

42 

WOWI 

43 

WOWI 

44 

wowi 

45 

wowi 

46 

WOWI 

47 

wowi 

48 

WOWI 

49 

wowi 

50 

WOWI 

51 

WOWI 

52 

wowi 

53 

WOWI 

54 

WOWI 

55 

wowi 

56 

wowi 

57 

WOWI 

58 

WOWI 

59 

wowi 

60 

WOWI 

61 

wowi 

62 

WOWI 

63 

wowi 

64 

WOWI 

65 

WOWI 

66 

wowi 

67 

WOWI 

68 

WOWI 

69 

WOWI 

70 

WOWI 

71 

WOWI 

72 

WOWI 

73 

WOWI 

74 

WOWI 

75 

WOWI 

76 

WOWI 

77 
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180 

CALL 

RAW 

G010 

30o 

190 

CALL 

ARB 

GOTO 

300 

200 

CALL 

TEC 

GO  10 

300 

210 

CALL 

I  OR 

GOTO 

300 

220 

CALL 

ARS 

c 

300  I JK=L I0+NB0- 1 

MAS  If R< l JK) =KL00P+ 1 15*(LR0+64*LR  I ) 

C 

310  IHkOUT.LL.O.  IG0T0  330 

IFIABSIRIN-DlST)  .GT.DIST*  1. u£-6)  GOTO  320 
KIN=01ST 
GOTO  330 
C 

320  lFIAOSIROUT-OlST  I  . L£ .0 1 S T*1 .0E-6 > ROUT  =  D l ST 
C 

330  I  JK  =  Lk  I  N-*-NBO-  1 
ASTtKI I J  K ) =  K  I N 
1 JK=LR0T+NB0-1 
ASTER  I 1 JK)=ROUT 

TEST  CONDITIONS  FOR  XB  IN  JREG  ( L TRUE  SET=l> 

400  IFl 10PEK.GT.4IG0T0  500 
C  (  +  )  OPERATOR  TEST  FOR  INSIDE  R IN.LE . 01  ST .L T.ROU T 

IFIRIN.GT.DISTIGOTO  700 
IFIDIST-RCU 1)600,700,700 

C  (-)  OPERATOR  TEST  FOR  OUTSIDE  OlST.LT.RIN  DIST.GE.ROUT 

500  IFIKOUT.LE.O. 1G0T0  600 
IFIOIST.LT, RINIGCTO  600 
IFIOIST.EO.RINJGOTO  700 
IFIOIST.LT. ROUTIGOTO  700 
C  CHECK  NEXT  BODY  IN  DESCRIPTION 

600  ifin.ge.ncigoto  BOO 
N=N+  1 

LOCU=LOCO+ 1 

CALL  UN2IL0CD, I0PER.N80) 

I  F ( IOPER.E0.1.OR.I0PER.E0.5)G0T0  800 
GOTu  10 

C  OR  OPERATOR 

700  1F( 1GP.NE. l.AND. I0P.NE.5)  RETURN 
IFIN.GE.NC 1RETURN 
N  =  N+  L 

DO  710  NN=N,NC 
L0C0=L0CD+1 

CALL  UN2IL0CD, 10PER»NB0) 

IF! IOPER.NE. I. AND. IOPER.NE.5JGOTO  710 
N  =  NN 
GOTO  tO 
710  CONIINUl 
RETURN 
C 

800  LTKUE=LTRUE+1 
RETURN 

END  126 
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WOW  I 

70 

WQWI 

79 

WOW! 

80 

WOWI 

01 

WOWI 

H? 

WOWI 

83 

WOWI 

84 

wgwi 

85 

WOWI 

86 

WOWI 

87 

WOWI 

88 

WOWI 

89 

WOWI 

90 

WOWI 

91 

wowi 

92 

wowi 

93 

WO  hi 

94 

WuWl 

95 

wowi 

96 

WOWI 

97 

WOWI 

90 

WOWI 

99 

WOWI 

100 

WOWI 

10) 

WOh  I 

102 

WOWI 

103 

WOW  I 

104 

WOWI 

105 

WOWI 

106 

wowi 

107 

wowi 

108 

WOWI 

109 

WOWI 

no 

WOWI 

111 

WOWI 

112 

WOWI 

113 

WOWI 

114 

WOWI 

1.15 

WOWI 

116 

WOWI 

117 

WOWI 

1  IB 

WOWI 

119 

WOWI 

120 

WOWI 

121 

WOWI 

122 

WOWI 

123 

WOWI 

124 

WGWI 

125 

WOWI 

126 

wowi 

127 

WOWI 

128 

WOWI 

129 

WOWI 

130 

wowi 

131 

WOWI 

132 

WOWI 

133 

WOWI 

134 

WOWI 

135 

WOWI 

136 

WOWI 

137 

SUBROUTINE  ARB 
DIMENSION  AA ( 6,4 ) ,XP | 3) 

COMMON  ASTER(30000) 

COMMON/ PAR EM/ XB(  3) ,WB(3> ,  IR 

•  tDA„.tSIN.L1,o,>uo.L0ic^ftiwSsr;™s%i;^:^^‘L’uKo' 


to 


20 

3C 

40 


50 


60 


65 

70 


L0C=10C0A-I 
00  10  1=1,6 
L0C=L0C+1 

CALL  UN2 ( LOC  »L0,  LC  ) 

AA([,X)= AS TER(LC) 

AA(  I  *2)=AST£P. (LC  +  l ) 

AAU,  3I=ASr£R(LC+2J 

AA( l , 4 )  =  ASTER! LD  1 

CONTINUE 

R1N=-PJNF 

ROUT=PINF 

LR0=0 

LRI=0 

Sl=0. 

S2=0. 

L1=C 

L2=0 

DO  70  I=i,6 
0=AA( I ,4  I 

S^sasosswaor 

IF  t  SNUM 140,70,70 
IFISNUMJ70, 70,40 
S=SNUM/SDEN 
DO  50  K=1 , 3 
XP(KI=XB(K)+S*WB!K) 

CONTINUE 

DO  60  J=  I  ,  6 

IF( I. EG. JIGQTO  60 

IF ( T. LT.O. ) GOTO  70 
CONTINUE 

IF(L1.GT.0IG0T0  65 
Ll  =  I 
Si  =  S 
GOTO  70 

CONTINUt1_S)*GT* 1,0E"6,G070  100 


LOO 


no 


IF(L1 1200,200, 150 

S2=S 

L2=I 

f 1  *t'e*S1*l*0E~5>G0T0  200 

IKSI-S2)110,200,120 
RIN=SI 
R0UT=S2 
Ul=Ll 
LK0=L2 
RETURN 
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ARB  2 

ARB  3 

ARB  4 

ARB  5 

ARB  6 

ARB  7 

ARB  « 


ARB 

9 

ARB 

10 

arb 

11 

ARB 

12 

ARB 

13 

akb 

14 

ARB 

15 

ARB 

16 

ARB 

17 

AKB 

18 

AKB 

19 

ARB 

20 

ARB 

21 

ARB 

22 

ARB 

23 

ARB 

24 

Arb 

25 

akb 

26 

ARB 

27 

ARB 

28 

ARB 

29 

ARB 

30 

ARB 

31 

ARB 

32 

ARB 

33 

ARB 

34 

ARB 

35 

ARB 

36 

arb 

37 

arb 

38 

arb 

39 

ARB 

40 

ARB 

41 

ARB 

42 

ARB 

43 

ARB 

44 

ARB 

45 

ARB 

46 

ARB 

47 

ARB 

48 

ARB 

49 

ARB 

50 

ARB 

51 

ARB 

52 

ARB 

53 

AKB 

54 

ARB 

55 

ARb 

56 

ARB 

57 

Aft  A  Co 
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120  P.  1 N  =  S  ? 

ARB 

60 

LR  l  =L2 

ARB 

61 

130  ROUT  =  S 1 

ARB 

62 

LK0  =  l.  1 

ARB 

63 

RETURN 

ARB 

64 

150  DO  160  J=1 

0 

ARB 

65 

lF(Ll.EO.J)f.OTO  160 

ARB 

66 

TUAAI  J,  1)*X8(  1)  +AAC  J,  2  1  *XB  (  2 )  +A  A  {  J ,  3 )  *XB(  3  )  +AAI  J  ,4 ) 

ARB 

67 

I F ( AOS  (  m 

.  LE .  1. 06 -ft ) T l  =  0. 

ARB 

68 

1F( T1.L1  .0 

)  GO  TO  200 

ARB 

69 

160  CONTINUE 

ARB 

70 

f.OTO  130 

ARB 

71 

ARB 

72 

200  R  1 N  =  P  I N  F 

ARB  „ 

73 

K0UT=-P IMF 

ARB 

74 

LR  I  =0 

ARB 

76 

LR0=0 

akb 

76 

RETURN 

ARP. 

77 

END 

ARB 

78 

ARB 

79 

ARB 

80 

SU3R0UT I  ME 

ARS 

**♦* 

30 

DIMENSION 

MASTER (30000) , COL 1( 3 ) , C0L2 ( 3 ) , C0L3 < 3 ) ,C0L4  (  3 ) , 

ARS 

2 

1  UI31  ,V(3)  ,  V.  (  3)  ,SAVE(84) 

ARS 

3 

COMMON  ASTER (30000) 

ARS 

4 

COMMON/P AREM/ XB( 3 ) »WB ( 3 ) » IR 

ARS 

5 

COMMON/ GFCM/ LB AS  E , R l N»R0UT »LRl »LRO,P INF, 16RR  »DI ST 

ARS 

6 

COMMON/UNCGEM/NRPP.NTRIP,  NSCAL ,NBOOY ,NRMAX, LTR IP,LSCAL , LREGD , 

ARS 

7 

1  L()AIA,LkIN,LR0I,LI0,L0C0A,U5,  130*LB00Y»NASC,KL00P 

ARS 

8 

COMMON/D AVIS/ ICR  I D,LOOP, I  NORM 

ARS 

9 

EQUIVALENCE (C0L1 1 ,  COL  1 ( 1 ) >, (COH  2  »COL 112)) , I  COL  13 ,C0L1 ( 3 ) ) 

ARS 

10 

EClU  1  VALENCE  (  CCL2  1 1 C0L2  (  L  )  ),  (C0L22  ,C0L2 1 2  )  )  ,  <  C0L23.C0L2  (  3  ) ) 

ARS 

11 

EOUI  VALENCE  I CCL3  1, C0L3I  l)  ) ,  ( COL32 , C0L3 (  2 ) )’.  (  COL33, C0L3I  3 ) ) 

ARS 

12 

EQUIVALENCE (C0L4 1 ,CCL4< 1 ) ), (C0L42 ,C0L4 ( 2 > ) , ( C0L43 , C0L4 (3) > 

ARS 

13 

EQUIVALENCE (AS  TER, MASTER) 

ARS 

14 

ARS 

15 

901  FORMAT ( IHO 

1 2 IH  TROUBLE  IN  ARS  AT  150) 

ARS 

16 

902  FORMAT! IHO 

,48HP0SS IBLE  ERROR  IN  ARBITRARY  SURFACE,  CHECK  INPUT, I5)ARS 

17 

ARS 

18 

ASTER/MASTER 

ARS 

19 

LOCDA+O 

T  TEMPORARY  STORAGE 

ARS 

20 

+  1 

M  NO.  CURVES 

ARS 

21 

♦  2 

N  NO.  POINTS/CURVE 

ARS 

22 

+  3 

IGDTt  GRID  TOLERANCE 

ARS 

23 

♦  4 

BIAS  NQ.  OF  NEGATIVE  OR  ZERO  HITS 

ARS 

24 

+  5 

X B (  X) 

ARS 

25 

♦  6 

XR  (  Y  ) 

ARS 

26 

♦  7 

XB (  Z  ) 

ARS 

27 

+  8 

(84  WORDS)  RESERVED  FOR  HITS 

ARS 

28 

• 

« 

ARS 

29 

• 

• 

ARS 

30 

• 

• 

ARS 

31 

+  91 

•  t 

ARS 

32 

♦  52 

X  )  ) 

ARS 

33 

• 

Y  ) N= l  )  M  SETS  OF  N  POINTS 

ARS 

34 

• 

Z  )  )  M=  1 

ARS 

35 

• 

K  )  ) 

ARS 

36 

• 

.  )  ) 

ARS 

37 

• 

.  )N=2  ) 

ARS 

38 

• 

.  )  ) 

ARS 

39 

128 
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I 


I 


UO  200  1  -  1  , KAPPA 
00  200  J  3  1  *  N 
l f  RY  *0 
K»|l*J)/2 
1000-*  I  ♦ J~2*K 

IW1=4*( ( I-1*ICOO)*N+JH-LOCARY 
If (N.LE. JIGOTO  190 
100  1V1*4*(  I*N+U-1>  I+LOCARY 

IU1=4*(  (  t-t)*N+(  J-1I  )*L0CARY 
1 F ( INORM.EQ.O (GOTO  110 

IF  (  UBS!  I  GR  1 0  -  HA  S  T  E  K  (  1U1  +  3!  I  .GT.  IGOTUGOTO  200 
I F { 1  A  B  S (  I GR I D-HA  S  TER ( I V 1 ♦ 3 ) I.GT. I GOT L ) GO  TO  200 
IF  I  1ABS1  I  GR  1  D-HA  STER  i  I W 1 1 3 )  I.GT.  IGOTUGOTO  180 
110  00  115  K=1 , 3 
I JK= 1 U 1 ♦ K  —  1 
U I K I  -  A  S  T  ER (  I  JK) 

1 JK  = 1 V 1 *K—  1  ; 

V(K)=ASTER< I JK ) 

I JK= l W l ♦ K- l 
W(K)=ASTf:K(  1JK) 

115  CONTINUE 

AT  THIS  TINE  wfc  HAVE  U.V.v,  SIDES  OF  TRIANGLE 


C 


C 


C 


C 


00  120  K-  1  *  J 
C0L1(K)=U(K)-W(K) 

C0L2(K)=V(K)-WIK) 

COL  3  I K I = -WB ( K  ) 

C0L4(K)=XR<K)-W(K) 

120  CONTINUE 

0  =  C0L11*(C0L22*C0L  3 3-COL 2 3  *C0L32  I 

1  -COL  12* (COL  2 1 ♦COL 3  3~C0L 2 3 ♦COL 3 1 ) 

2  «-C0L  13*(C0L21*C0L32-C0l22*C0L31  I 
IFIAHSIUI.LE. 1.0E-6IG0T0  180 

DAL  PH A  =  COL 5  1  *  (COL  22*C0L33-C0L23*C0L 32  I 

1  -COL 52* (C0L21 *COL  33-C0L23*C0L3 1 ) 

2  +C0L43* IC0L21*C0L32-C0L22*C0L31  I 
ALPHA=OALPHA/D 

IF  I  ALPHA*! 1 .-ALPHA I.LI.O.  IGOTO  180 

OBLTA  =  COL  I l*(C0L42*C0L33-C0L43*C0L32) 
1  -COL12*(COL4l*COL33-COL43*COL3l) 

?  +COL 13*(C0L41*C0L32-C0L42*C0L31 ) 

BE  I A  =  DBE  T A/0 

IF (BETA*! l.-BFTA l.LT.O. IGOTO  180 
TP*ALPHA*BETA 

IF( IP*( l.-TP) .LT.O. IGOTO  180 

DS  =  C0L11*(C0L22  *COL  43-C0L23  *C0L42 I 

1  -COL  12*  (C0L2l*C0L43-C0L23*C0L41  I 

2  *COL 13* (COL  21 *COL  4 2- COL  22  *COL  4 1 1 
S=DS/0 


If INHI IS. GT. 20 IGOTO  400 
LIMI  T-NIUTS+1 
L I M I  I 1-L0CHTS+20*NE-1 
TR Y= l -  I TRY-ITRY 


! 


ARS 

100 

ARS 

101 

ARS 

102 

ARS 

103 

ARS 

104 

ARS 

105 

ARS 

106 

ARS 

107 

ARS 

10B 

ARS 

109 

ARS 

1 10 

Aks' 

111, 

ARS 

i \i 

ARS 

113 

ARS 

a  i4 

ARS 

115 

ARS 

l  16 

ARjj 

117* 

ARS 

1  IH 

A.RS 

1  19 

ARS 

120 

ARS 

121 

ARS 

122 

ARS 

123 

ARS 

124 

ARS 

125 

A.R  S 

126 

ARS' 

127 

ARS 

128 

ARS 

129 

ARS  1 

1  130 

ARS 

131 

ARS 

1-32 

ARS 

133 

ARS 

134 

ARS 

135 

ARS 

136 

ARS 

1  37 

ARS 

138' 

ARS 

139 

ARS 

140 

ARS 

141 

ARS 

142 

AKS 

143 

ARS 

1'44 

ARS 

145 

ARS 

146 

ARS 

147 

ARS 

.  148 

ARS 

149 

ARS 

150 

AKS 

151 

ARS 

152' 

ARS 

153 

ARS 

154 

ARS 

155 

AKS 

156 

ARS 

157 

ARS 

158 

ARS 

159 

130 


oor'oo  ooo 


CAU  CR0SS(C0L3,C0Ll«C0L2) 

ARS 

160 

00  140  L^.3 

*  ARS 

161 

COL3(L)=TRY*COL3(L) 

: 

AKS 

•  162 

140 

CONTINUE 

. 

ARS 

163 

00  150'  L  =  1',LJMIT 

,  ARS 

164' 

1N0EX=L0CHT S+ ( L- 1 ) *N£  : 

j 

AKS 

165 

IF  i  S.LF. ASTER! INDEX) JG0T0 

l$0 

\ 

,  ARS 

,166 

150 

CONTINUE  i 

1  ARS 

16  7 

WHITE  (6,901)' 

'AKS 

168 

GOTO  180 

ARS 

i  69 

i  i  * 

,  ARS 

\  70 

1 

ARS' 

171 

160 

00  165  L=  I NDEX  »L IN  I  T 1 

• 

ARS 

172 

I  JK=L IM1 T l  +  INDEX-L 

» 

ARS 

in 

I JKl= I JK+-NE  . 

‘  AKS 

174 

ASTLK( lJKl)=ASTER( IJK) 

* 

AKS 

175 

165 

CONTINUE 

,  .  ARS 

176 

ASTER.(  INOEX  )  =  S  < 

■  ARS 

1  77 

00  170  L= 1 , 3 

■  J 

ARS 

178 

1JK=INDEX*L 

ARS 

179 

A$TER(IJK>=C0L3(L) 

i 

,  ,  A’RS 

180 

i70 

CONTINUE 

J  t  » 

1  ARS 

181 

NHI TS=NHI TS+ l 

AKS 

182 

180 

IF ( ITKY.GT .0)G0T0  200  i 

.  ,  ARS 

183- 

190 

I W 1= I W 1-8 

j  \ 

AKS 

184 

1THY=1:  ,  •  1 

AKS 

165 

IF(J.GT.1)G0T0  100 

i  » 

ARS 

186 

200 

CONTINUE  1 

; 

ARS 

187 

i 

1 

t 

AKS 

188 

THIS  SECTION  CHECKS  .FOR  PROPER  ENTER-LEAVE  SEQUENCE 

IN  HITS  TABLE  AR:S 

189 

1 

1 

ARS 

190 

I F (NHI TS-l)800»210,220  ' 

i  » 

r.RS 

191 

210 

AS  TER ( LOCHTS ) =PI NF 

ARS 

192 

t 

I JK=LOCHTS+NE 

•  * 

ARS 

.193.  ■ 

AS!TER(IJK)=PINF 

ARS  • 

194 

GOTO  800  ■■ 

' 

ARS 

195 

220 

ILEAVE= l 

! 

ARS 

196 

SL AST=-P INF 

* 

;  ARS 

1.9  7 

, 

ARS 

198 

lLEAVE  =  -1  IMPLIES  AN  ENTRY  , 

AKS 

199 

ILEAVE*  =  +1  IMPLIES  AN  EXI.T  •  ! 

ARS 

200 

ENTRIES  AND  EXITS  SHOULO  ALTERNATE  IN  TABLE 

ARS 

201 

! 

ARS 

202 

00  300  L=1 ,NHITS 

ARS 

203 

INDEX=LUCHTS*(L-1)*NE 

■ 

,  .ARS 

204J 

00  230  L  1  =  1,3 

i 

AKS 

205 

> 

IJK=INDEX*L:1  •’ 

*  ,  ARS 

206 

C0L4(L1)=ASTER(I  JK) 

i 

ARS 

207 

230 

CONTINUE  1 

i 

,  ARS 

208 

TEMP=DOT ( WB , C0L4 ) 

, 

ARS 

209 

INEAT=SIGN( 1.0, TEMP) 

ARS 

2  10 

IF (A8S(SLAST-ASTEK (INDEX ) ) 

.GT. 1.0E-7IG0T0  235 

ARS 

21 1 

1F(  REAVE’*INEXT.GE:.0>G0T0 

260  . 

ARS 

212 

LTRY=L 

ARS 

213 

INDEX=INOEX-NE 

. 

,  .  ARS 

214 

i 

GOTO  270 

• 

ARS 

215 

235 

I JK= INOEX+NE  . 

AKS 

2  16 

I F (ABSI ASTER ( INOEX )-ASTER( IJK) ).GT.l,0E-7)G0Tp  240 

ARS 

217 

IF  (  REAVE*  INEXT)  290,250, 250 

ARS 

218 

240 

IF  (  REAVE*  INEXT)  290, 280, 280 

ARS 

219 

131 


c 

ARS 

220 

c 

BAD  START  OF  A  NEW  S  SET  -  TRY  TO  FIND  AN  ALTERNATING  MEMBER 

ARS 

221 

c 

ARS 

222 

250 

LTRY=U 

ARS 

223 

251 

LTRY*LTRYM 

ARS 

224 

1FCLTRY.GT.NH1TSIG0T0  280 

ARS 

226 

INDEX  1=L0CHTS+ILTRY-1)*NE 

ARS 

226 

IF {ABS! ASTER! INDEX >- ASTER ( IN0EX1 5 I .GT. 1.0E-7IG0T0  280 

ARS 

227 

DO  252  L 1= 1 » 3 

ARS 

228 

IJK=IMDcXl+Ll' 

ARS 

229 

C0L4(Ll)=ASTERU  JK  I 

ARS 

230 

252 

CONTINUE 

ARS 

231 

TEMP=OOT (W8»C0L4) 

ARS 

232 

1N£XT=SIGN( l.O,TEMP) 

ARS 

233 

IF(  ILEAVE*1NEXT.GE.0)G0T0  251 

ARS 

234 

LTRY=L+l 

ARS 

235 

GOTO  270 

ARS 

236 

c 

ARS 

2  37 

c 

AT  THIS  POINT  wE  HAVE  DETECTED  TWO  CONSECUTIVE  ENTRIES  OR  EXITS 

ARS 

238 

c 

TRY  TO  RESOLVE  BY  DELETING  ITEMS  WITH  EQUAL  S  ENTRIES 

ARS 

239 

c 

t  ■ 

ARS 

240 

260 

LTRY=i 

ARS 

241 

261 

LTRY=LTRY+1 

ARS 

242 

IFUTRY.LE.NHITSIGOTO  262 

ARS 

243 

LTRY=L+1 

ARS 

244 

GOTO  2 70 

ARS 

245 

262-. 

.  index i=lochts+il  try- i  i*ne 

ARS 

246 

IFIArtSI  ASTER!  INDEX )- ASTER !  INDEX  1 5 I »LE*  t.OE-7 1  GOTO  263 

ARS 

247 

LTRY=L+l 

ARS 

248 

GOTO  270 

ARS 

249 

263 

DO  264  L 1  =  1 »  3 

ARS 

250 

I JK=IN0EX1+Ll 

ARS 

251 

C0L4(L1!=ASTER(IJK) 

ARS 

252 

264 

CONTINUE 

ARS 

253 

TfcMP=00T(WB,C0L4> 

ARS 

254 

INEXT=SIGN( 1.0, TEMPI 

ARS 

255 

IF!  ILEAVE*INEXT.GE.O)GOTO  261 

ARS 

256 

L  IRY=L 

ARS 

257 

INOtX=INDEX-NE 

ARS 

258 

GOTO  270 

ARS 

259 

c 

ARS 

260 

c 

PROCEED  TO  FORGET  FROM  INDEX  THRU  NEXT  ENTRY  WITH  DIFFERENT  S 

ARS 

261 

c 

COMMENCING  TO  CHECK  WITH  THE  L  TH  ENTRY 

ARS 

262 

c 

ARS 

263 

273 

INDEX 1=L0CHTS+!L TRY- i)*NE 

ARS 

264 

IF! ABS! ASTER! INDEX1I-ASTER! INDEX ) ) .GT.O. I  GOTO  271 

ARS 

265 

LTRY=LTRY+ 1 

ARS 

266 

270 

NHITS=NHITS-1 

ARS 

267 

IF«NHITS-1)800,210,273 

ARS 

268 

271 

DO  272  LTRY=INDEX, LIMIT1 

ARS 

269 

IJK=ITRY+IN0EX1- INDEX 

ARS 

270 

ASTER(LTRY)=ASTER( IJK) 

ARS 

271 

272 

CONTINUE 

ARS 

272 

GOTO  220 

ARS 

273 

c 

ARS 

274 

280 

WRITE  (6,902) INDEX 

ARS 

275 

290 

SLAST=ASTER( INDEX) 

ARS 

276 

ILEAVE= (NEXT 

ARS 

277 

300 

CONTINUE 

ARS 

278 

or.  o  no 


NOW  CHOOSE  THE  HIT  (THIS 

SECTION  ALSO  ENTERED  FOR  REENTRY! 

ARS 

280 

ARS 

281 

© 

o 

>r 

00  420  1*1,20 

ARS 

282 

11ST*L0CHTS*< I-i I^NE 

ARS 

283 

12ND=L0CHTS*I*NE 

ARS 

284 

IF (ASTER! I2NDI.GE.PINFIG0T0 

800 

ARS 

285 

IF ( ASTER ( 1 1ST ) .GE. PI NF IGOTO 

800 

AKS 

286 

IF  ( ABS ( ASTER  ( 1 1ST! -ASTER < I2NDI). LE. l.OE-7  IGOTO  420 

ARS 

287 

IF(0IST.LT«ASTER(I1ST)IG0T0 

410 

ARS 

288 

IFIOIST. GT. ASTER ( 1 2ND) )G 

OTO 

420 

ARS 

269 

410 

K*(MASTER(iBIAS)+il/2 

AKS 

290 

IF (2*K-I-MASTER( IS  IAS ) )500, 

UI 

o 

o 

AKS 

291 

420 

CONTINUE 

AKS 

292 

ARS 

2  93 

500 

RIN=ASTER{ 1 1ST) 

ARS 

294 

R0Uf=ASTEK( 12ND) 

ARS 

295 

GOTO  BIO 

ARS 

296 

510 

RlN=ASTER( 1 2ND  J 

AKS 

29  7 

IJK=12ND+NE 

AKS 

298 

R0UT=AST£R(  IJK) 

. 

ARS 

299 

GOTO  010 

ARS 

300 

BOO 

RlN=-PlNF 

ARS 

3C1 

R0UT=0. 

ARS 

302 

810 

IF (NASC.GT.-2 IRE  TURN 

AKS 

303 

00  820  1=1,84 

ARS 

304 

IJK=L0CHTS+I-1 

ARS 

305 

ASTtR(lJK)=SAVE(  I) 

AKS 

306 

820 

CONTINUE 

ARS 

307 

RETURN 

ARS 

308 

END 

AKS 

309 

ARS 

310 

AKS 

311 

SUBROUTINE  BOX 

■ 

*#** 

31 

DIMENSION  MASTER ( 30000 1 

BOX 

2 

COMMON  ASTER ( 300C0 I 

BOX 

3 

C0MMGN/PAREM/XB(3) ,WB13) 

,IR 

BOX 

4 

COMMON/GEOM/L8ASE, RINjROUT, 

LRI,LRO,PINF,IERR»OIST 

BOX 

5 

COMMON/UNCGEM/NRPP.NTRIP 

, NSCAL , NBODY, NRMAX, LTR IP , LSCAL , LREGD , 

BOX 

6 

1  LDATA,LRIN,LR0T,LI0,L0C0A 

, I 15, I3O,LBODY,NASC,KL0OP 

BOX 

7 

EQUIVALENCE  ( MASTER, ASTER  I 

BOX 

8 

BOX 

9 

CALL  UN2 ( LOCDA, IV, IH1 I 

BOX 

10 

LOC=LOCDA+ 1 

BOX 

11 

CALL  UN2IL0C* IH2  * IH3 ) 

BOX 

12 

RIN=-PINF 

BOX 

13 

ROUI=PINF 

BOX 

14 

DO  105  1*1,3 

BOX 

15 

IF ( 1-2 111,12,13 

BOX 

16 

11 

11=2 

BOX 

17 

GOTO  14 

BOX 

18 

12 

11  =  1 

BOX 

19 

GOTO  14 

BOX 

20 

13 

11=3 

BOX 

21 

14 

A=0. 

BOX 

22 

VP=0. 

BOX 

23 

W=0. 

BOX 

24 

DO  15  J=  1 » 3 

BOX 

25 

JV=IVfJ 

BOX 

26 

JA=IH1+J 

BOX 

27 

VP=VP+ (ASTER(JV-l)-XB(J) I *ASTER( J A-l ) 

BOX 

28 

133 


W*N*N8UI*AST£RC  JA-ll 

BOX 

29 

A*A*A$TER< JA-l>**2 

BOX 

30 

IS 

CONTINUE 

BOX 

31 

1F{W»30*20,40 

BOX 

32 

20 

IFI-VPiLT.O.JGOTO  200 

BOX 

33 

1FI-VP-A ) 100 » 100 ,200 

BOX 

34 

30 

CP*VP/W 

BOX 

35 

L0*2*il-1 

BOX 

36 

IF (CP.LE.O. IGOTO  200 

BOX 

37 

CM*(VP*A»/N 

BOX 

38 

Ll-LO+l 

BOX 

39 

GOTO  60 

BOX 

40 

40 

CP*(VP*A)/W 

BOX 

41 

1.0*2*  1 1 

BOX 

42 

IFICP.LE.O. IGOTO  200 

BOX 

43 

CM*VP/W 

BOX 

44 

LI*L0-1 

BOX 

45 

60 

IF (ROUT* LE. CP IGOTO  80 

80X 

46 

ROUT*CP 

BOX 

47 

LR0*L0 

BOX 

48 

80 

IF (RIN»GE*CM)G0T0  100 

BOX 

49 

RIN*CM 

BOX 

50 

LRI=L! 

BOX 

51 

100 

IH1* IH2 

BOX 

52 

IH2=IH3 

BOX 

53 

105 

CONTINUE 

BOX 

54 

I F  ( ABS ( R IN-ROUT) .LE.R0UT*1.0E-6)G0T0  200 

BOX 

55 

IF(RIN«LT«ROUT ) RETURN 

BOX 

56 

200 

RIN*PINF 

BOX 

57 

R0UT=-PINF 

BOX 

58 

RETURN 

BOX 

59 

ENO 

BOX 

60 

c 

BOX 

61 

c 

BOX 

62 

SUBROUTINE  ELL 

**** 

32 

DIMENSION  FOCI A( 3),F0CIB(3) » MASTER! 30000 ) 

ELL 

2 

COMMON  ASTER ( 30000 ) 

ELL 

3 

COMMON/PAREM/XBI 3) »WB(3) , IR 

ELL 

4 

C0MM0N/GE0M/L8ASEy RINtROUTf LRI *LROf PINFy IERRyDIST 

ELL 

5 

COMMON/UNCGEM/NRPPyNTRIPyNSCALyNBOOVyNRMAXyLTRIPyLSCALyLREGD, 

ELL 

6 

1  LDATAy LRINyLROTy LIOyLOCOAy I1S« I30»LB0DY»NASC,KL00P 

ELL 

7 

EQUIVALENCE  ( ASTER, MASTER  >• 

ELL 

8 

c 

ELL 

9 

CALL  UN2 ( LOCOA, I VI, I V2 I 

ELL 

10 

I RR*MASTER ( LOCOA+1 I 

ELL 

11 

FOCI  A ( 1)*ASTER(IVI) 

ELL 

12 

FOC I A ( 2)sASTER(IVl*l) 

ELL 

13 

F0CIA(3)=ASTER(lVl+2> 

ELL 

14 

FOCIB ( 1 ) =ASTER ( I V2 ) 

ELL 

15 

F0CIB(2)*ASTER(IV2+1) 

ELL 

16 

FOC IB( 3)=ASTER(IV2+21 

ELL 

17 

C*ASTER( IRRJ 

ELL 

18 

RIN=PINF 

ELL 

19 

ROUT=-PINF 

ELL 

20 

01X*XBm-FCCIA(  1) 

ELL 

21 

D1Y=XB!2)-F0CIA(2) 

ELL 

22 

D1Z=XB ( 3 I-FOCI A( 3 ) 

ELL 

23 

D2X=XB(1)-F0CIBI 11 

ELL 

24 

02Y*XB(2)-F0CIBI 2)  , 

D2Z=XB(3)-F0CIB(3)  -% 

ELL 

25 

ELL 

26 

Ai  *2.  *  ( o  i  x*we  t  n+DiY*wBm*oiz*w«(3)  j 

A2*2.*(D2X*WB<  1)*D2Y*WB(2)*D2Z*WB<3) ) 

BI=DIX*1)1X»D1V*U1Y*I)1Z*UIZ 

B2*02X*()2X+C2Y*n2Y*02Z*02Z 

AA  =  U2-A1)/(2.*C )  , 

BB=(C*G*B2-Bi)/(2.*C)  / 

ALAMD*AA*AA-1. 

ALAM1= ( AA*B8-. 5* A2 ) / ALAMO 
U=<B0*BB-B2)/ALA«D 
D!SCRM=ALAM1*ALAK1-U  / 

IF  (OISCKM.UE.,0.) RETURN  / 

S0RTUI=S0RT  (OISCRM)  / 
KlN=-ALAMl-SQRTD(  / 
R0UT=-ALAM1+S«RTD1  j 
RETURN  / 

end  / 


SUBROUTINE  RA*  / 

DIMENSION  Hl(3)»H2(3)»H3(3)»V(3)*AS0(3)»PV(4)»G(3) 

COMMON  ASTER (3OO0O) 

C0MM0N/PAREM/X8(/3)  ,WB(3)  ,  IR 

C0MM0N/G60M/LBASE,RINtR0UT,LRI,LR0,PINF, IERR,DIST 
COMMON/UNCGEM/N'RPP,NTRIP.NSCAL,NBODY,NRMAX,LTRIP,LSCAL,LREGD, 
l  LDATA, LRINt URO T*  L I  0, LOCDA , 1 15» 1 30»  LBODY»NASC  *KL00P 

CALL  UN2(L0CKA,IV# IH1 I 
LOC=LOCDA+l  / 

CALL  UN2(L0C, IH2,IH3) 

H1CU=ASTE/(IHU 
Hl(2)=ASTER( IH1+1) 

HI ( 3 ) =ASTtR ( IHl+2 ) 

H2( I)=ASTER( Ih2) 

H2  l 2 ) =ASTER ( I H2+ 1 ) 

H2 ( 3 1 = AS TER ( IH2*2  I 
H3(l)?A$TER(IH3) 

H3(2>=ASTER(IH3+1) 

H3(3)=ASTER( IH3+2) 

V(  1  )=ASTER( IV) 

V(2)=ASIER( IV+ll 
V(3)~ASTERl IV+2) 

RIN=-PINF 

ROUT*PINF 

CM*-PINF 

CP*PINF 

L=0 

LI*0 

K=0 

LRI=0 

LR0*0 

ASQ( 1 ) =H1 { l ) *H1( 1 ) +H l ( 2 ) *H1 (2 ) +H 1 ( 3) *H1 ( 3 ) 

ASO (2 )=H2 ( I )*H2( l ) +H2 ( 2 ) *H2 (2)+H2(3)*H2(3) 

ASQ(3)=H3( I»*H3( I)+H3(2)*H3(2)+H3(3)*H3(3) 

XB1V1*XB(1)-VU) 

X62V2«XB(2)-V(2) 

XB3V3*X8(3)-V(3) 

PV< 1)=XBIV1*HIU )+XB2V2*Hi(2)*XB3V3*Hl (3) 

PV(2)=XB1V1*H2(I )+XB2V2*H2( 2)+XB3V3*H2( 3 ) 

PV( 3)*XBIVI*H3 (1 ) +XB2V2*H3( 2 ) +XB3V3*H3 ( 3 ) 
G(l)=WB<l)*Hl(l)+WB(2)*Hl(2)+WB(3>*Hl(3) 


ELL 

27 

ELL 

28 

ELL 

29 

ELL 

30 

ELL 

31 

ELL 

32 

ELL 

33 

ELL 

34 

ELL 

35 

ELL 

36 

ELL 

37 

ELL 

38 

ELL 

39 

ELL 

40 

ELL 

41 

ELL 

42 

ELL 

43 

ELL 

44 

**** 

33 

RAW 

2 

RAW 

3 

RAW 

4 

RAW 

5 

RAW 

6 

RAW 

7 

RAW 

8 

RAW 

9 

RAW 

10 

RAW 

11 

RAW 

12 

RAW 

13 

RAW  ‘ 

14 

RAW 

15 

RAW 

16 

RAW 

17 

RAW 

18 

RAW 

19 

RAW 

20 

RAW 

21 

RAW 

22 

RAW 

23 

RAW 

24 

RAW 

25 

RAW 

26 

RAW 

27 

RAW 

28 

RAW 

29 

RAW 

30 

RAW 

31 

RAW 

32 

RAW 

33 

RAW 

34 
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10 

20 

30 


AO 

50 

C 

60 


90 

100 

C 

no 

130 

140 


150 


180 

190 


C. 

210 


C 

230 


260 


G(2)=WB{l)*H2(l)+WB(2)*H2(2)+W8{3)*H2C3) 
G(,3 )  =  WB  1 1 )  *H3  ( 1 )  ♦WBI  2)  *H3  (2  > ♦WBI  3)*H3(  3 ) 

00  140  1=1,2 
IF(G(  l)  )  10,110,60 

1FI-PVI  1 1)20,400,400 

rcMps-pvm/Gm 

I F ( TEMP-CP 130,  130,  130 

CP=IEMP 

L  =  1 

GOTO  1 40, 50 1 , I 

LR0=3 

GOTO  130 

LR0=1 

GOTO  130 

(Fl-PVl  M.LE.0.1G0T0  130 

TEMp=-pvin/Gm 

IFITFHP.LE.CPIGOTO  130 

CM=lbMP 

K- 1 

G0T0190, 100) , I 
LRl  =  3 
GOTO  130 
LRI  =1 
GOTO  130 

IF1PV1 I ) . LE.O. )GOTO  810 
IFlPVm.GE.ASQlI)  JGOTO  810 
Ll=Ll+l 
CONTINUE 


1F1G1 3) 1150,210,230 

TEMP=ASQ( 3  )-PV (3  ) 

IF1TEMP.GE.0.JG0T0  180 

TEMP=TEMP/G(3) 

IFITEMP.LE.CM1G0T0  190 

CM=TEKP 

K=3 

IRI=A 

IF (-PV1 3 1)190,400, 400 
TEMP=-PV(3)/G<3) 

IF  I  TEMP. GE. CP ) GOTO  290 

CP=TEMP 

0=3 

LR0=5 

GOTO  290 

IFIPVI3) .LE.O. 1G0T0  400 
I F { PV ( 3 ) -ASQ (3)1290,290, 400 

1FI-PV(3).LE.0.)G0T0  260 

TEMP*-PV(3 )/G( 3) 

IF(TEMP.LE.CM)G0T0  260 

CM=TEMP 

K=3 

LR  1=5 

TEMP=AS0(3)-PV(3) 
IFITEMP.LE.O. 1G0T0  400 
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136 


TEMP=T£MP/G( 3) 

IF(TEMP.G£»CP)GOTO  290 

CP=  T GMP 

L*3 

LR0*6 

290  AG= AS0( 2 )*G( l ) +A  SQ ( 1 >  *GI 2  > 

PVI4)*PV(1)*ASQ(2)*PV(2)*ASQ<1> 
I0P=ASQ< 1>*ASC12)-PV<4) 

IF( AG >310,3 50 ,330 

310  TEMP=T0P/AG 

IF{ lEMP.LE.CKJCOTO  380 

CM=TEMP 

K=4 


C 


C 


C 


C 


C 

C 


C 


LRI=2 
GOTO  380 

330  IFITOP.LT.O.IGOTO  400 
TEHP=TOP/AG 

I F  { TEMP-CP  >370(360(380 

350  IF(PV(4).LE.0.Jti0T0  400 
IF ( -TOP  >  380,400, 400 
370  CP=TEMP 
L=4 
LK0=2 

380  IF(L+K.LE.0)G0T0  400 
ROUT=CP 
R1N=CM 

400  IF(ROUT.GE.PINF)GOTO  810 
IFIROUT.LE.O.JGOTO  BIO 
IFIRIN.GE.ROUT JGOTO  810 

IF  I ABSIR IN-ROUT) .GT.ROUI *1.G£— 5)G0T0  820 

810  R0UT=-PINF 
KIN=PINF 
LR0=*0 
LRI*0 

820  RETURN 
END 


SUBROUTINE  RCC 

DIMENSION  V(3>,H(3),MASTER( 30000) 

COMMON  ASTER  1 30000) 

COMMON/PAREM/XBI 3) ,WB<  3> ,  IR 

C0MM0N/GE0M/L8ASE,RIN,  ROIJT,  LRI,LRO,P  INF,  IERR.01ST 
COMMON/UNCGEM/NRPP,NTRIP,NSCAL,NBOOY,NRMAX,LTRIP,LSCAL,LREGD, 
1  LDATA ,IR IN ,LROT , LI  0, LOCO A ,115, 130,LB0DY,NASC,KL00P 
EQUIVALENCE  ( ASTER, MASTER  ) 


CALL  UN2 (LOCO A, I  V, IH) 
IRR*MASTER ( LOCDA+l ) 

H( 1 )>ASTER( IH) 
H(2)«ASTER< IH*1) 
H(3)-ASTER(IH*2> 

VI 1)*ASTERI IV) 

V( 2)* ASTER! IV* 1) 
V(3)*ASTERI IV+2) 
R*ASTER( IRR) 
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**** 

34 

RCC 

2 

RCC 

3 

RCC 

4 

RCC 

5 

RCC 

6 

RCC 

7 

RCC 

8 

RCC 

9 

RCC 

10 

RCC 

11 

RCC 

12 

RCC 

13 

RCC 

14 

RCC 

15 

RCC 

16 

RCC 

17 

RCC 

18 

137 


R|N=-PINF 

RCC 

19 

R0UT=PINF 

RCC 

20 

KSO=R*R 

RCC 

21 

LR0=0 

RCC 

22 

LR  1=0 

RCC 

23 

T0P=0. 

RCC 

24 

P0l=0. 

RCC 

25 

l)+H(2)*H{2)+H(3)*H(3) 

RCC 

26 

VPH=H( 1 )*( V( 1 } -XB ( 1) )+H(2)*(V{2)-XB{ 2» )+H(3l*(Vt3)-XB(3»J 

RCC 

27 

'wH=WB  1 1 1  *H  1 1 1 +  WB  (  2  I  *H{  2  5  +  W8  (  3)  3 1 

RCC 

28 

UEN=NH-WH*WH 

RCC 

29 

00  10  1=1,3 

RCC 

30 

rop=rop*w8(  n*(XBi  i)"V(  m 

RCC 

31 

pot=pot+(xb<  i  i-vun**2 

RCC 

32 

10 

CONTINUE 

RCC 

33 

AM60=-HH*T0P-WH*VPH 

RCC 

34 

UM= ( POT-RSQ ) *HH-VPH**2 

RCC 

35 

IF (wHI4u,70,50 

RCC 

36 

40 

CP=VPH/WH 

RCC 

37 

CM= ( VPH+HH I  /WH 

RCC 

38 

LCP=  1 

RCC 

39 

LCH=2 

RCC 

40 

GOTO  60 

RCC 

41 

50 

CP=( VPH+HH )/WH 

RCC 

42 

CM= VPH/WM 

RCC 

43 

LCM=1 

RCC 

44 

LCP=2 

RCC 

45 

60 

IF ( CP ) 300,80,80 

RCC 

46 

70 

CP=PINF 

RCC 

47 

CM=-CP 

RCC 

48 

IFIVPH.GT.O. JGOTC  300 

RCC 

49 

IF (HH+VPH 1300,90,90 

RCC  ■ 

50 

80 

IFIABS10EN1.GE.1.0E-6IG0T0  90 

RCC 

51 

Rl=-P I NF 

RCC 

52 

K2=P1NF 

RCC 

53 

GOTO  100 

RCC 

54 

90 

R  1=0. 

RCC 

55 

R2=0. 

RCC 

56 

amboa=ambo/oen. 

RCC 

57 

UMU=UM/OEN  . 

RCC 

58 

0ISC=AMB0A**2-UMU 

RCC 

59 

IFUHSC.LE.O. IGOTO  300 

RCC 

6C 

SO=SORT (DISC) 

RCC 

61 

Rl=AMBDA-SO 

RCC 

62 

R2=AMB0A+SD 

RCC 

63 

100 

IF (CM.GT.R1 IGOTO  110 

RCC 

64 

RIN=R1 

RCC 

65 

LR  1=3 

RCC 

66 

GOTO  120 

.  RCC 

67 

110 

RIN=CM 

RCC 

68 

LR 1 =LCM 

RCC 

69 

120 

IFICP.LE.R2 IGOTO  130 

RCC 

70 

R0UT=R2 

RCC 

71 

LR0*3 

RCC 

72 

GOTO  200 

RCC 

73 

130 

ROUT=CP 

RCC 

74 

LR0=LCP 

RCC 

75 

200 

IF ( ABS ( ROUT-RIN) . LE. R0UT*1.0E-5) GOTO  300 

RCC 

76 

G0T0I210, 210, 2201, LRO 

RCC 

77 

210 

Fl*DEN*R0UT**2-2.*AMBD*R0UTHJM 

RCC 

78 

138 


o  o 


RCC  79 
RCC  so 
RCC  81 
RCC  82 
RCC  83 
RCC  84 
RCC  85 
RCC  86 
RCC  87 
RCC  '88 
RCC  89 
RCC  90 
RCC  91 
RCC  92 
RCC  93 
RCC  94 
RCC  95 
RCC  96 


RCC 

97 

RCC 

98 

SUBROUTINE  REC 

**** 

35 

DIMENSION  V(3)»H(3)»A(3)*tS(3) 

REC 

2 

COMMON  ASTER (30000) 

REC 

3 

COMMON/ PAREM/XB( 3 ) ,WB( 3 ) »  IR 

REC 

4 

COMMON/GEOM/L8ASE,RIN,ROUT,LRI,LRO,P!NF,  IERR.DIST 

REC 

5 

C0MM0N/UNCG6H/NRPP,NTRIP»NSCAL ,N80DYfNRMAX»L  fRIP,LSCAL,LREGD, 

REC 

6 

1  LDATA, LR IN , LRO  T,LI0,L0CDA,I15» I30,LB0DY,NASC,KL00P 

REC 

7 

REC 

8 

CALL  UN2 ( LOCCA, IV, IH) 

REC 

9 

L0C=L0CDA+l 

REC 

10 

CALL  UN2 (LOC, 1A, IB) 

REC 

11 

V( 1 )=ASTER( IV) 

REC  ' 

12 

V( 2 ) =ASTER ( I V+l) 

REC 

13 

V( 3)=ASTER( IV+2) 

REC 

14 

H( 1 )=ASTER( IH) 

REC 

15 

H(2)=ASTER{ IH+l) 

REC 

16 

H{3)=ASTER( IH+2) 

REC 

17 

A( 1 )=ASTER( IA) 

REC 

18 

A(2 )= ASTER! IA+1) 

REC 

19 

A(3)=ASTER(IA+2) 

REC 

20 

B( 1 )=ASTER ( 18 ) 

REC 

21 

B(2)*A$TER( IB+1) 

REC 

22 

B ( 3 )=ASTER ( I B+2) 

REC 

23 

RIN=-PINF 

REC 

24 

ROUT=PINF 

REC 

25 

LR0=0 

REC 

26 

LR  1=0 

REC 

27 

AA=A(  l)*A(l)+A(2)*A(2)+A(3)*A(  3) 

REC 

28 

BB=B( l)*B(l)+B(2)*BC2)+BI3)*BC3) 

REC 

29 

V1XB1=V( l)-XB(l) 

REC 

30 

V2XB2=V ( 2 )-XB( 2) 

REC 

31 

V3XB3=V { 3 )-XB( 3) 

REC 

32 

VPA=V1XB1*A(1)+Y2XB2*A(2)+V3XB3*A(3) 

REC 

33 

VPB=V1XBI*B( i)+V2XB2*B(2)+V3XB3*B(3) 

REC 

34 

WBA=WB ( 1)*A(1)+WB(2)*A(2)+WB(3)$A(3) 

REC 

35 

MBB=WB( 1 )*B( 1)+HB(2)*B(2)*W8C3)*B(3) 

REC 

36 

WBAWBA=WBA*WBA 

REC 

37 

WBBW8B=WBB*WBB 

REC 

38 

AAAA=AA*AA 

REC 

39 

BBBB=BB*BB  139 

REC 

40 

IF(F1)250,250,300 
220  F1=R0UT*WH-VPH 

I F ( F 1 ) 300 ,250,230 
GOTO  230 

230  IF(Fl.Gl.HH)  GOTO  300 
250  GOTO { 260,260, 270 ), LR I 
260  F 1 =OEN*R 1N**2~2. *AMBD*RIN+UH 
IF(F1)310, 310,300 
270  Fl=RIN*WH-VPH 

IF1FD3U0, 310,280 
GOTO  280 

280  1 F { F 1 .LF .HH } GO  TO  310 
300  RIN=PINF 
R0UT=-PINF 
LR0=0 
LR1=0 

310  RETURN 
END 


4MrfO=wBA*VP  A*888B  +  V'iBB*VPB*AAAA 

HEC 

4] 

UM=BBHB+VPA*VPA+  AAAA*VPB*VPB~AAAA*BBBB 

RF.C 

42 

OEN=WBAWBA*BBBB+WBBWBB*AAAA 

REC 

43 

1F( ABS(OEN) . LE . 1 .OE-61GOTO  10 

RFC 

44 

AMBIM-AMBD/DEN 

REC 

45 

UMU=UM/DEN 

REC 

46 

01 SC=AMbDA**2-UMU 

REC 

47 

IFlOISC.LF.O. 1GOTO  300 

REC 

48 

S0=S0RT(01Sc: 

REC 

49 

IU=AHB0A-S0 

REC 

50 

R2=AKRDA*SD 

REC 

51 

GOTO  20 

REC 

52 

10 

R  L  = — P INF 

REC 

53 

R2=P l NF 

REC 

54 

20 

HH=H ( l ) *H I 1 ) +H ( 2 )*H(2)+H<3)*H(3) 

REC 

55 

WH=wB  (  1  )*H{  1I+WB  (2)*H(2)+WB(3)*H(3) 

REC 

56 

V?H=V1XB1*H{ 1 )+V2XB2*H<2)+V3X63*H(31 

REC 

57 

IF (KM  140,70.50 

REC 

58 

40 

IH VPH.GE.O. 1G0T0  300 

REC 

59 

CP-VPM/WH 

REC 

60 

CM= { VPH+HH ) /WH 

REC 

61 

LCP=  l 

REC 

62 

GCM=2 

REC 

63 

GOTO  100 

REC 

64 

‘.VO 

VPHHH= VPH+HH 

REC 

65 

IF (VPHHH.LE.O. 1G0T0  300 

REC 

66 

CP=VPHHH/WH 

REC 

67 

CM=VPH/WM 

REC 

68 

LCM=  1 

REC 

69 

LCP  =  2 

REC 

70 

GOTO  100 

REC 

71 

70 

CP=P INF 

REC 

72 

CM=-CP 

REC 

73 

100 

IFICM.GI  .RDGOTO  110 

REC 

74 

R I  N=R 1 

REC 

75 

LR I  =3 

REC 

76 

GOTO  120 

REC 

77 

110 

KiN-CM 

REC 

78 

LK  l  -LCM 

REC 

79 

120 

IFICP.Lfc.R2)G0T0  130 

REC 

80 

ROUT =R2 

REC 

81 

LR0  =  3 

REC 

82 

GOTO  200 

REC 

83 

130 

KOUT=CP 

REC 

84 

LRO=LCP 

REC 

85 

200 

IF ( ABSIROUT-RINJ .LE.ROUT*l.OE-5)GOTO  300 

REC 

86 

G0TOI21O,210,22O),LR0 

REC 

87 

210 

F 1*DEN*R0UT**2-2«*AHB0*R0UT +UM 

REC 

88 

IFIF1}250,250,300 

REC 

89 

220 

F  1=R0UT*WH-VPH 

REC 

90 

IF(Fl) 300*250*230 

REC 

91 

GOTO  230 

REC 

92 

230 

IF ( FI «GT .HH JGOTO  300 

REC 

93 

250 

G0T0(260,260,270),LRI 

REC 

94 

260 

F l*DEN*R IN**2-2. *AMBO*Rl N+UM 

REC 

95 

IFIF1)310,310,300 

REC 

96 

270 

F1=RIN*WH— VPH 

REC 

97 

IF(Fl) 300*310* 280 

REC 

98 

GOTO  280 

REC 

99 

280 

IFIFl.lE.HHJGOTO  310 

REC 

100 

140 


300 

KIN=P1NF 

l  -  ■ 

R0UT=-P1NF 

RtC 

iJ. 

LR 1  =0 

a  Ft 

It* 

LK0=0 

RFC 

UH 

310 

RETURN 

RFC 

!£»% 

END 

REC 

1  Cfc 

c 

RFC 

10? 

c 

REC 

1  OS 

SUBROUTINE  RPPINGO) 

36 

DIMENSION  MASTER ( 30000 >,PR(6),LR I  6 > , XS ( 6 ) ,LS T I  6 J 

RPP 

2 

COMMON  ASTER  I  30000) 

RPP 

3 

C0MM0N/PAREM/X8I 3) ,W6{3) , IR 

RPP 

4 

C0MM()N/GE0M/L8ASE,RIN,R0Ur,LRt  ,LR0,PINF,  I ERR, D  1ST 

RPP 

5 

COMMON /UNC GEM/NR  PP ,NTR I P , NSCAL »NBODY ,NRHAX,L  TR IP ,LSCAL , LREGD » 

RPP 

6 

1 

L0ATA,LRIN,LR0T,U0,L0CDA,I15,  I30,LB0DY,NASC,KL00P 

RPP 

7 

EQUIVALENCE  ( MAS  TER, ASTER ) 

RPP 

8 

c 

RPP 

9 

901 

FORMAT l 1H0* 12HERR0R  IN  RPP/4H  L  * , I 10 , 5X ,4HNB0* , I 10 , SX , 3HI R= , 

RPP 

10 

1 

I10/4M  XB=,3E20.10/4H  W8=,3E20. 10/4H  PR=,6E20. 10/4H  LR=,6il0) 

RPP 

11 

c 

RPP 

12 

LST I 1 ) =1 

RPP 

-  13 

LST ( 2 ) = 1 

RPP 

14 

L  ST  I  3 ) =2 

RPP 

15 

LSTC4 ) =2 

RPP 

16 

LST l 5 ) =3 

RPP 

17 

LST I 6 ) =3 

RPP 

18 

L=0 

RPP 

19 

PR ( 1 ) =0. 

RPP 

20 

PR  I  2 ) =0. 

RPP 

21 

DO  10  1=1,6 

RPP 

22 

xsm=siNB0,n 

RPP 

23 

10 

CONTINUE 

RPP  ’ 

24 

r 

V/ 

RPP 

25 

DO  IOC  1=1,6 

RPP 

26 

1 I=LST ( I  ) 

RPP 

27 

TEMP=XS I  I ) — X B ( 1 1 ) 

RPP 

28 

IF  I  MB ( 1 1 ) )  20,100,30 

RPP 

29 

20 

IF ( TEMP  J40, 100 ,100 

RPP 

30 

30 

IF' TEMP.LE.O. JGOTO  100 

RPP 

31 

40 

TRY=TEMP/WB( I I ) 

RPP 

32 

00  60  J= 1 , 3 

RPP  . 

33 

IF ( J.EO. I I ) GOTO  60 

RPP 

34 

XRY=XB(J}+TRY*WB(J) 

RPP 

35 

I F ( IXS 1 2  *J-1 J-XRY ) *( XRY-XS I 2*J  ) ) .LT.O. )GOTO  100 

RPP 

36 

60 

CONTINUE 

RPP 

37 

L*L+1 

RPP 

38 

PR  I L )  =  TRY 

RPP 

39 

LR( L)=I 

RPP 

40 

IFIL.EQ.2JG0T0  130 

RPP 

41 

IFIL«LT.2)G0T0  100 

RPP 

42 

WRITE  {6,901)L,NB0,IR,XB,M8,PR,LR 

RPP 

43 

ROUT=-PINF 

RPP 

44 

RETURN 

RPP 

45 

100 

CONTINUE 

RPP 

46 

GOTO  160 

RPP 

47 

c 

RPP 

48 

130 

IF  I ABS ( PRI l I-PRC  2 ) ) . LE. PR (1) *1 .0E-6) GOTO  200 

RPP 

49 

IF  I  PR  (ll-PRI  2 1)140,180,150 

RPP 

50 

140 

R!N*PR( 1 ) 

RPP 

51 

LRI=LR( 1 )  141 

RPP 

52 

ROUf =PR{ 2) 

RPP 

53 

LKO=LR I 2 ) 

RPP 

54 

RETURN 

RPP 

55 

150 

R  I  N  =  PR ( 2  ) 

RPP 

56 

LK  l  =LR I 2 ) 

RPP 

57 

K0U1=PR( 1 ) 

RPP 

58 

LRO  =  lR (  l ) 

RPP 

59 

KL IURM 

RPP 

60 

c 

RPP 

61 

160 

1FIL.GE.  DGOTO  180 

RPP 

62 

1/0 

KOUl =-P 1 NF 

RPP 

63 

RE TURN 

RPP 

64 

180 

R[N=-PINF 

RPP 

65 

LR  I  =0 

RPP 

66 

ROUdPRI 1 ) 

RPP 

67 

LRO=LR( l ) 

RPP 

68 

Ktl URN 

RPP 

69 

c 

RPP 

70 

200 

DO  220  J-l  t3 

RPP 

71 

!F(XB(J).LT.XS(2*J-IHG0T0  170 

RPP 

72 

!F{XB;j) .GT.XS(2*J ) (GOTO  170 

RPP 

73 

220 

Cunt inuE 

RPP 

74 

GOTO  180 

RPP 

75 

CNO 

RPP 

76 

c 

RPP 

77 

c 

RPP 

78 

SUBROUTINE  RPP2I LSURF, XP, IRP) 

**** 

37 

c 

FINDS  ABUI1NG  RPP 

RPP2 

2 

DIMENSION  XP (  3 ) 

RPP2 

3 

COMMON  ASTER (30000) 

RPP2 

4 

COMMON/PAREM/XBI 3) *WB ( 3 ) , IR 

RPP2 

5 

COMMON/uEOM/LBASE,RINfROUT,LRI .LRO.PINF, IERR.DIST 

RPP2 

6 

COMMON/UNCGEM/NRPP , NTR I P  *  NS CAL tNBOOY  »NRMAXf  LTRIP»LSCAL  *  LREGD, 

RPP2 

7 

l  LDATA,LR1N,LR0T,LI0,L0CDA,I15, I30,LBOOY,NASCtKLOOP 

RPP2 

8 

c 

RPP2 

9 

(.0C=LBASE+12*(NASC-l  )-2*(  LSURF  + 1 ) 

RPP2 

10 

CALL  UN2(L0C,L0CAT,NC1 

RPP2 

11 

I F { NC-1 ) 10  *  20 1  30 

RPP2 

12 

10 

IRP=0 

RPP2 

13 

RETURN 

RPP2 

14 

20 

CALL  UN2IL0CAT, IRP.DUM) 

RPP2 

15 

RETURN 

RPP2 

16 

30 

M=1 

RPP2 

17 

c 

RPP2 

18 

DO  90  I  =  1 » NC 

RPP2 

19 

M*-M 

RPP2 

20 

(F(M.GT.O)GOTO  50 

RPP2 

21 

CALL  UN2(L0CAT,I 1, 12) 

RPP2 

22 

LOCAT*LQCAT+ l 

RPP2 

23 

IRP= I 1 

RPP2 

24 

GOTO  70 

RPP2 

25 

50 

I RP= I 2 

RPP2 

26 

70 

LS* ( l-LSURF ) /2 

RPP2 

27 

DO  80  J* 1 » 3 

RPP2 

28 

IFI  J.E0.LS1G0T0  80 

RPP2 

29 

IF  (  (S(  IRP,2*J-1)-XP(  J)  )*<XP(  J)-S'l  IRP,2*J)).LT.0.)GCT0  90 

RPP2 

30 

80 

CONTINUE 

RPP2 

31 

RETURN 

RPP2 

32 

90 

CONTINUE 

IRP=0  142 

RPP2 

33 

RPP2 

34 

RETURN 

bND 


SUB ROUT  I Nfc  SPH 
COMMON  ASTER (30000) 

C0MM0N/PAREM/X8( 3) ,WB( 3) , IR 

COMMON/('.EOM/LBASE,KIN,ROUT,LRI  ,LRO,PINF,  IERR.OIST 
COMMON/UNCGEN/NR PP ,NTRI P , NSCAL ,N80DY ,NRMAX, L TR IP, L SCAL , LREGD, 
l  LOATA,LRIN,LROf,LI 0, LOCO A ,I15,I30»LB0DY,NASC,KL00P 

CALL  UN2(L0CDA,ITEKP, 12) 

R=ASTER( (?) 

1 TcMP= I TFMP  + l 

OX=XB( l)-ASTER( I 1ENP-1 ) 

UY=XB(2)-ASTER(I TEMP) 

0Z  =  XB(3)-ASTERU  TEMP  +  l  ) 
b=L)X*WB (  l)-*-DY*WB(2)«-0Z*WB(3) 

C=OX*DXH)Y*OY+UZ*DZ-R*R 

01 S=8*B-C 

IF (C.GT .0. JGOTO  10 

R IN=-P INF 

ROu  T=SQRT( D I S )-B 

RE  I  URN 

10  IFIU1S.GT.0. JGOTO  20 
RIN=PINF 
ROUT  =-P I NF 
RETURN 

20  01 S=SORT ( 01 S ) 

RIN=-B-OIS 

ROUT=-B+OIS 

RETURN 

END 


SUBROUTINE  TEC 

DIMENSION  MASTER (30000), DELTA! 3), HF( 3), AUN( 3) 

COMMON  ASTER (30000 ) 

COMMON/PAREM/XB! 3) *WB(3>,  IR 

COMMON/GEOM/LBAS  E , RI N, ROU  T,LRI,LROtPINF, IERR.OIST 
COMMON/UNCGEM/NRPP ,NTR I P , NSCAL ,NBOOY,NRMAX,LTRIP,LSCAL, LREGD, 
l  LDATA,LRIN,LR0T, LI  0 » LOCO A ,115,130, LBODY»NASC  t KLOOP 
EQUIVALENCE  ( MASTER, ASTER ), (GAMMA, S IGMA ) 

REAL  NF ( 3 ) , K ( 3 ) »  M, M2.MM, MM2 


CALL  UN2 ( LOCDA , I  V, IH> 
L0C=L0CDA+1 
CALL  UN2(L0C, IN, IA) 
L0C=L0C+ l 

CALL  UN2(L0C,IKL,IK2) 
I RC=MASTER  <  LOC  +  l ) 

RI  =  ASTER ( IRl ) 

R2=ASTER ( IR2 ) 
R3=R1/ASTER(IRC) 
R4=R2/ASTER( IRC) 
DDN=0. 

WDA=0. 

DDA*0. 

HDA*0. 

HDN=0. 
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RPP2 

35 

RPP2 

36 

RPP2 

3? 

RPP2 

3B 

**** 

38 

SPH 

2 

SPH 

3 

SPH 

A 

SPH 

5 

SPH 

6 

SPH 

7 

SPH 

8 

SPH 

9 

SPH 

10 

SPH 

II 

SPH 

12 

SPH 

13 

SPH 

1 A 

SPH 

15 

SPH 

16 

SPH 

17 

SPH 

18 

SPH 

19 

SPH 

20 

SPH 

21 

SPH 

2.2 

SPH 

23 

SPH 

2A 

SPH 

25 

SPH 

26 

SPH 

27 

SPH  • 

28 

SPH 

29 

SPH 

30 

SPH 

31 

**** 

39 

TEC 

2 

TEC 

3 

TEC 

A 

TEC 

5 

TEC 

6 

TEC 

7 

TEC 

8 

TEC 

9 

TEC 

10 

TEC 

11 

TEC 

12 

TEC 

13 

TEC 

1A 

TEC 

15 

TEC 

16 

TEC 

17 

TEC 

18 

TEC 

19 

TEC 

20 

TEC 

21 

TEC 

22 

TEC 

23 

TEC 

2A 

TEC 

25 

WUN-O- 

TEC 

26 

DO  100  1=1,3 

TEC 

27 

11=1-1 

TEC 

28 

J1=IV+11 

TEC 

29 

J2=IH+I 1 

TEC 

30 

J3=IN+I 1 

TEC 

31 

J4  =  I  A* 1  1 

TEC 

32 

DELTA(I)=ASTER(Ji)-XB{I) 

TEC 

33 

HFU  )=ASTERCJ2) 

TEC 

34 

NF{ I )=ASTER( J3) 

TEC 

35 

AUN( 1 )  =ASTER ( J4) 

TEC 

36 

UON=DL:L  TA 1 I ) *NF ( IJ+DON 

TEC 

37 

WUA=WB(  I  J  *AUN (  I)+WL'A 

TEC 

38 

DOA=D£L  T  A ( I ) *A(JN ( I J  +  OOA 

TEC 

39 

HOA=HF ( I ) *  AUN ( I) +HDA 

TEC 

40 

i<ON=HFf  l  )*NF(  I  J  +  HON 

TEC 

41 

toDN=WB ( I } *NF ( Il+WOK 

TEC 

42 

100  CONfINUt 

TEC 

43 

CALL  CROSS (K, AUN ,  NF ) 

TEC 

44 

WOK=OOT ( WB  »  K ) 

TEC 

45 

OOK=t)OT ( DELTA, K) 

TEC 

46 

H0K=00r { HF »K ) 

TEC 

47 

IF  1 ABS ( WON) .GT.1.0E-71G0T0  300 

TEC 

48 

GAMMA=-ODN/HDN 

TEC 

49 

IFIGAMMA.LT.O. 1G0T0  900 

TEC 

50 

KTP=GAMMA-1. 

TEC 

51 

IF(RTP.GT.0.)G0T0  900 

TEC 

52 

M=GAMMA*R3+R  1* { l .-GAMMA) 

TEC 

53 

MM=GAMMA*R4+R2*( 1. -GAMMA) 

TEC 

54 

M2=M*M 

TEC 

55 

MM2=MM*MM 

TEC 

56 

T=SIGMA*HDA+DDA 

TEC- 

57 

TI=SIGMA*HDK+COK 

TEC 

58 

A=MM2*WDA**2+M2*WDK**2 

TEC 

59 

8=-(MH2*WDA*T+M2*WDK*TT } 

TEC 

60 

C=MM2*T**2+M2*Tr**2-K2*PM2 

TEC 

61 

DISC=B*8-A*C 

TEC 

62 

IFIOISC.LT.O. )GOTO  900 

TEC 

63 

IF1DISC.GT.0. )OISC=SQRT{ DISC) 

TEC 

64 

R IN= ( -8-01  SC ) /A 

TEC 

65 

K0UT= {-8+0 1  SC ) /A 

TEC 

66 

LR  1  =  3 

TEC 

67 

LR0=3 

TEC 

68 

GOTO  950 

TEC 

69 

C 

TEC 

70 

300  FLlPO=i. 

TEC 

71 

IF (WDN.LT.O. )G0T0  310 

TEC 

72 

FLIP0=-1. 

TEC 

73 

WDA=-WDA 

TEC 

74 

WON=-WON 

TEC 

75 

WOK=-WDK 

TEC 

76 

310  ALPHA* HON/ WON 

TEC 

77 

OETA*OON/WDN 

TEC 

78 

TAU«(R3/R4)**2 

TEC 

79 

A* ( ALPHA*WQA-HOA I **2+TAU* ( ALPHA* WOK-HDK ) **Z- TAU* ( R4-R2 ) **2 

TEC 

80 

B=  -(-ALPHA*8ETA*WDA**2*ALPHA*W0A*DDA«'BETA*WDA*HDA-DDA*HDA 

TEC 

81 

l  +TAU*t -ALPHA*BETA*WDK**2*AIPHA*W0K*DDK«'BETA*WDX*HDK-DDK*HDK 

TEC 

82 

2  +R2*R4-R2*R2 ) ) 

TEC 

83 

C=(D0A-8ETA*W0A)**2*TAU*( 1 00K-8ETA*W0K )**2-R2**2 I 

TEC 

84 

01 SC=B*B-A*C 

TEC 

85 

144 


iFiDisc.tr. o. j go ro  900 
IF (DI SC. GT.O. )DI SC=SQRT (DISC) 
1F{AB$(A),LE.1.0E-7)G0T0  330 
IFU)320,330,340 
320  SI GMA1= ! -B-OJ SC) /A 
5IGMA2=(-B+0ISC1 /A 
GOTO  350 

330  SIGMAl=-C/( 2. *8) 

S1GMA2=-PINF 
IF l SIGMA1 >900,350, 350 
340  S ( GMA1={ -B+DI SC) /A 
S1GMA2= ( -8-01  SC) /A 
350  SIGMAP=-Rl/(R3-tU  ) 

IF(SIGMA2.GT.1.)G0T0  900  xv 

IF(SIGMAI.LI.O.)GOTO  900 
IF(SIGMA1.GT.1.)G0T0  410 
IF(SIGMA2,Gr.O.)GOTO  400 

RI N=ALPHA*S I GMA1  *P,  E  f  A 

LK I  =3 

R0UT=B6  r  A 

LR0=1 

GOTO  490 

400  RIN=ALPHA*S IGMA1 +BETA 
LRI  =  3 

R0UT= ALPHA* SIGMA 2+ BET A 

LR0=3 

GOTO  490 

410  IF(SIGMA2.GT.0.)G0T0  440 

IF(SIGMA1.GT.SJG MAP) GOTO  900 

RIN=ALPHA+BETA 

LRI=2 

ROUT=BETA 

LR0=1 

GOTO  490 

*40  IF( S IGMAl.GT .SIGMAPJGOTO  460 
RIN=ALPHA*BETA 
LRI=2 

ft0UTaALPHA*SIGMA2+BETA 

LR0=3 

GOTO  490 

460  RIN=ALPHA*SIGMA2+BETA 
IRI=3 
ROUT=BETA 
LR0*1 

C 

490  IFtFUPO.GE.O.  JGOTO  950 
RTP^RIN 

itp=lri 

RI N=~ROUT 
LRI»LRO 
RGUT*-RTP 
LRQ* I  TP 
GOTO  950 
900  RIN*PINF 
ROUT=-PINF 

950  IF (ROUT. GT.O. ) GOTO  1000 
RIN*PINF 
RGUT*-P I NF 
RETURN 

1000  IF(ABS(ROUT-RINI .LE.R!N*1.0E-6)G0T0  900 


TEC  86 
TEC  87 
TEC  88 
TEC  89 
TEC  90 
TEC  91 
TEC  92 
TEC  93 
TEC  94 
TEC  95 
TEC  96 
TEC  97 
TEC  98 
TtC  99 
TEC  100 
TEC  101 
TEC  102 
TEC  103 
TEC  104 
TEC  10 5 
TEC  106 
TEC  107 
TEC  108 
TEC  109 


TEC 

no 

TEC 

m 

TEC 

112 

TEC 

113 

TEC 

114 

TEC 

115 

TEC 

116 

TEC 

•  117 

TEC 

118 

TEC 

119 

TEC 

120 

TEC 

121 

TEC 

122 

TEC 

123 

TEC 

124 

TEC 

125 

TEC 

126 

TEC 

127 

TEC 

128 

TEC 

129 

TEC 

130 

TEC 

131 

TEC 

132 

TEC 

133 

TEC 

134 

TEC 

135 

TEC 

136 

TEC 

137 

TEC 

138 

TEC 

139 

TEC 

140 

TEC 

141 

TEC 

142 

TEC 

143 

TEC 

144 

TEC 

145 

145 


o  o 


RL  TURN 
END 


SUBROUTINE  TOR 

DIMENSION  MASrER(30000),XHCV{3),C(4),RTI4),RTS{4>,XAW(3) ,XTRY(3) 
COMMON  ASTER ( 30000 ) 

C0MM0N/PAREM/X8I 3) ,WB(3) ,IR 

COMMON/GEOM/L8AS£,RlNtROUT,LRI,LRO,PINF, I  ERR, D 1ST 
COMMON/UNCGEM/NRPP,NTRIP,NSCAL,NBODY,NRMAX,LTRIP,LSCAL,LREGD, 

1  LDAfA,LRIN,LROT,LlO,LOCCA,I15,  I30,LBODY,NASC,KLOOP 
EQUIVALENCE  ( MAS  TER, ASTER ) , { 01  ST , STHUS ) 

REAL  NF ( 3 ) 

C 

CALL  UN2 ( LOCDA, J  V  *  IN) 

LOC=LOCDA+ 1 

CALL  UN2 ( LOC » I R1 » I R2 ) 

R1=ASTFR ( IR1 ) 

K2=ASTE*U  IR2) 

W0N=0. 

XMC2=0. 

Aw=SQRT(U0TIWB»W8)  ) 

00  10  1=1,3 
J1=IV+I-1 

XAwU)=ASrER(  JD-XBI  1  ) 

10  CONTINUE 

RSAVE=ABS( DOT { XA W»  W8 ) /AW ) -R1-R2-R2 
IF(NASC.E0.-2)RSAVE=0. 

00  20  1=1,3 

XTRYI  I  )  =  XBU  )*RSAVE*WB<  I  ) 

20  CONTINUE 

DO  100  1=1,3 

J1=IV+I-1 

J2=IN+l-l 

NF ( I )=ASTER ( J2 ) 

XMCV  m  =  XTRY(l)~  ASTER  IJ1) 

XMC2=XMCV{ I )**2+XMC2 
WDN=WB 1 1 ) *ASTER( J2 l+WDN 
100  CONTINUE 

WDXMC=D0  T ( WB , XMC  V I 
XMCDN=DOT ( XMC V  ,NF ) 

R12=Rl*Kl 

R22=R2*R2 

TERM=R12+R22-XMC  2 

C<  1)=4<,*WDXMC 

TEMP=4.*WDXMC**2 

C(2)=4.*R12*WDN**2-2.*TERM+TEMP 

C( 3)=8.*R12*WDN*XMCDN-4.*WDXMC*TERM 

C(4)=4.*R12*( XMCDN**2-R22 )+TERM**2 

CALL  QRT IC(C,RT»NR) 

I F ( NR-2 1110,120,140 
C  TOR  NOT  HIT 

110  RIN=0. 

R0UT=-PINF 
P>E  TURN 

C  2  ROOTS 

120  1FIRT ( 1) . GE . R  T (2 ) )G0T0  130 
RIN=RT ( 1 ) 

R0UT*RT 1 2 )  ,,, 

GOTO  900  146 


TEC 

146 

TEC 

147 

TEC 

148 

TEC 

149 

**** 

40 

TOR 

2 

TOR 

3 

TOR 

4 

TOR 

5 

TOR 

6 

TOR 

7 

TOR 

B 

TOR 

9 

TOR 

10 

TOR 

11 

TOR 

12 

TOR 

13 

TOR 

14 

TOR 

15 

TOR 

16 

TOR 

17 

TOR 

18 

TOR 

19 

TOR 

20 

TOR 

21 

TOR 

22 

TOR 

23 

TOR 

24 

TOR 

25 

TOR 

26 

TOR 

27 

TOR’ 

28 

TOR 

29 

TOR 

30 

TOR 

31 

TOR 

32 

TOR 

33 

TOR 

34 

TOR 

35 

TOR 

36 

TOR 

37 

TOR 

38 

TOR 

39 

TOR 

40 

TOR 

41 

TOR 

42 

TOR 

43 

TOR 

44 

TOR 

45 

TOR 

46 

TOR 

47 

TOR 

48 

TOR 

49 

TOR 

50 

TOR 

51 

TOR 

52 

TOR 

53 

TOR 

54 

TOR 

55 

TOR 

56 

130 

RlN-RT  C  2 ) 

TOR 

57 

R0UT=RTI 1) 

TOR 

58 

GOTO  900 

TOR 

59 

4  ROOTS  SELECT  FIRST  PAIR  „GE.  DIST  AS  RIN  AND  ROUT 

TOR 

60 

140 

Rrsm*=RT(l) 

IOR 

61 

IF ( K  T  <  2 ) .LT.RTS(l) )GOTO  150 

TOR 

62 

«TS(2)=RT<2) 

TOR 

63 

GOTO  160 

TOR 

64 

150 

RTS ( 2 ) *KTS ( 1 ) 

TOR 

65 

RTSI 1 ) *RT ( 2 ) 

TOR 

66 

160 

IFiRT<3).LT.RTSI2))G0T0  170 

TOR 

67 

RTS ( 3 ) *RT ( 3 ) 

TOR 

68 

GOTO  190 

TOR 

69 

170 

RTS(3)*RTS(2) 

TOR 

70 

IFIRT(3I.LT.RTS<  1DG0T0  180 

TOR 

71 

RTS(2)=RT ( 3) 

TOR 

72 

GOTO  190 

TOR 

73 

180 

RTS(2)=RTS(l> 

TOR 

74 

RIS(1)=RT(3) 

TOR 

75 

190 

IFIRTI4) .LT.RTSI 3) JGOTO  200 

TOR 

76 

RTS(4J=RT<4J 

TOR 

77 

GOTO  300 

TOR 

78 

200 

RTS( 4 ) =RTS ( 3) 

TOR 

79 

IF(RT(4).LT.RTS<21 JGOTO  210 

TOR 

80 

R  T  S ( 3 ) =RT ( 4 ) 

TOR 

81 

GOTO  300 

TOR 

82 

210 

RTS(3)=RTS(2i 

TOR 

83 

IFIRT(4).LT.RTS( 1) JGOTO  220 

TOR 

84 

RTS ( 2 ) =RT ( 4 ) 

TOR 

85 

GOTO  300 

TOR 

86 

220 

R  TS ( 2 )=RTS( 1 ) 

TOR 

87 

RTS(l)*RT(4» 

TOR 

88 

STHUS=CIST 

TOR 

89 

300 

IF(ABSISTHUS-RTST2)).LE.1.0E-7)G0T0  310 

TOR 

90 

IF( STHUS.GE.RTSt 2) JGOTO  310 

TOR 

91 

R I N=RTS ( 1 l 

TOR 

92 

ROUT=RTS ( 2 ) 

TOR 

93 

GOTO  900 

TOR 

94 

310 

RIN=KTS( 3) 

TOR 

95 

R0UT=RTS(4) 

TOR 

96 

TOR 

97 

900 

LR  l  =  l 

TOR 

98 

LR0=  l 

TOR 

99 

RIN=R  IN+RSAVE 

TOR 

100 

R0U1'=R0UT  +  RSAVE 

TOR 

101 

IF  (ROUT .GF.« 0.0  JGOTO  920 

TOR 

102 

910 

RIN=PINF 

TOR 

103 

RQUT=-P I NF 

TOR 

104 

RETURN 

TOR 

105 

920 

IFUfiS(ROUT-RIN) . LE. RI N*l .OE-6 ) GOTO  910 

TOR 

106 

RETURN 

TOR 

107 

END 

TOR 

108 

TOR 

109 

TOR 

110 

SUBROUTINE  TRC 

**** 

41 

DIMENSION  MAST  ER  (  30000  ) »  V  (  3  )  »H  (  3.) 

TRC 

2 

COMMON  ASTER { 30000 ) 

TRC 

3 

COMMON/PAREM/XBI  3) ,WB(3J  ,  IR 

TRC 

4 

COMMON/GEOM /L BASE*  RI N, ROUT  »LRI»LRO»PINF»IERR*DIST 

TRC 

5 

COMMON/UNCGEM/NRPP,NTRIP,NSCAL,NBOOY,NRMAX, LTRIPtLSCAL, LREGD, 

TRC 

6 

147 


1  LOAfA,LRlN,LROT,LIO,LOCQA*Il5,!30,LBODY,NASC«KLOOP 

TRC 

7 

EOU l  VALENCE (MASTER , ASTER ) 

TRC 

B 

TRC 

9 

CALL  UN2 ( LOCDA , I V, I H 1 

TRC 

10 

LOC=LOCDA«-l 

TRC 

11 

CALL  UN2(LOC»lRB,lRTOP) 

TRC 

12 

V( 1)*ASTER{ IV) 

TRC 

13 

V(2S=AST£R(  l  V*- 1 ) 

TRC 

14 

V( 31=ASTER( IV+21 

TRC 

15 

Hill =AST  ER ( IH) 

TRC 

16 

H(2)=ASTER( IH+l) 

TRC 

17 

H(3)=ASTER( IH+21 

TRC 

18 

RB- ASTER ( IRB  J 

TRC 

19 

KT=ASTER(IRTOP) 

TRC 

20 

RlN=-PlNF 

TRC 

21 

ROUT=PINF 

TRC 

22 

LR0=0 

TkC 

23 

LR  1=0 

TRC 

24 

INI S£C=0 

TRC 

25 

1NTRI=0 

TRC 

26 

INTR2=0 

TRC 

27 

VIXB1=V{  ll-X6(  1) 

TRC 

28 

V2XB2=V12)-XB(2) 

TRC 

29 

V3XB3=V(3)-XB(3) 

TRC 

30 

PVPV=V1XB l* VlXBl +V2Xb2*V2XB2+V3X83*V3XB3 

TRC 

31 

VPW=VIXB1*WB(  1  )■*•  V2XB2*WB  1 2 )  *V3X83*W6  13  1 

TRC 

32 

WH  =WBm*H{l)^WBC2)*H(2)+WBC3)*Hl3» 

TRC 

33 

VPH=V 1XB l*H (1) +V2XB2*H( 2 ) +V3XB3*H<  3) 

TKC 

34 

HH=H( 1 )*H( 1 )  *H  ( 2 )*H{ 2 ) +H { 3 1 *H 13) 

TRC 

35 

RTRB=RT-RB 

TRC 

36 

RBRTVP*RB-VPH*RTRB/HH 

TRC 

37 

VPHHH=VPH+HH 

TRC 

38 

UM=HH* ( PVPV-RBRT VP**2 1-VPH^VPH 

TRC 

39 

AHBD=HH*VPW-WH*{ VPH-RTRB*RBRTVP 1 

TRC 

40 

DEN=HH-WH**2*( 1»  +RTRB**2/HH 1 

TRC 

41 

IF(ABS(0EN).GT.1.0E-6)G0T0  AO 

TRC 

42 

IF(RTRB.EO.O. JGOTO  200 

TRC 

43 

R2=UM/(2.*APB0) 

TRC 

44 

F 1=R2*WH-VPH 

TRC 

45 

IFIF1.LT .0. 1G0T0  200 

TRC 

46 

IFtFi.GT.HHIGOTO  200 

TRC 

47 

INTSEC=INTSEC+l 

TRC 

48 

IFtWH.LE.O. (GOTO  10 

TRC 

49 

IF(RTRB)20, 20,30  s 

TRC 

50 

10  IF(RTRB) 30,30,20 

TRC 

51 

20  LR0=3 

TRC 

52 

ROU  T  =  K  2 

TRC 

53 

GOTO  250 

TKC 

54 

30  LR 1=3 

TRC 

55 

R I N=R2 

TRC 

56 

INTSEC= I  NT  SEC  +  1 

TRC 

57 

GOTO  210 

TRC 

58 

TRC 

59 

40  AMBOA=AHBD/OEN 

TRC 

60 

UMU=UM/OEN 

TRC 

61 

0 I SC=AMdOA**2-UMU 

TRC 

62 

IF(0ISC)350,200,50 

TRC 

63 

GOTO  50 

TRC 

64 

50  $D=SQRT ( 01  SC  )  148 

TKC 

65 

Rl=AMBDA-SO 

TRC 

66 

R2*AMBDA+S0 

TKC 

67 

Fl*R2»WH-VPH 

TRC 

63 

IF1F1.LT.0. JGOTO  60 

TRC 

69 

IFCFl.LE.HH) 1NTR2MNTR2+1 

TRC 

70 

60 

F1=K1*WH-VPH 

TRC 

71 

IFIFI.LT.O. JGOTO  70 

TRC 

7, 

IF1F1.LE.HHJG0T0  80 

TRC 

73 

70 

IF11NTR2.LT.1J GO TO  200 

TRC 

7'. 

R0UT=R2 

TRC 

75 

KIN=R2 

TRC 

76 

LR0=3 

TRC 

77 

LR  1  =  3 

TRC 

78 

INTSEC=INTS£C+1 

TRC 

7< 

uOTO  200 

TRC 

6C. 

80 

INTR1=INTR1*1 

TRC 

81 

I F( INTR2.GE. 1JG0T0  90 

TKC 

82 

R0UT=R1 

TRC 

33 

R 1 N=R 1 

TRC 

84 

LK0=3 

TRC 

85 

LR1=3 

TRC 

86 

1NTSEC=1NTSEC+1 

TRC 

8/ 

GOTO  200 

TRC 

88 

90 

IF ( R1-R2 ) 100 1 350 • 1 10 

TRC 

89 

100 

R  IN=R 1 

TRC 

90 

K0UT=R2 

TRC 

91 

LR0=3 

TRC 

92 

LRI=3 

TRC 

93 

GOTO  300 

TRC 

9* 

110 

RIN=R2 

TRC 

95 

R0UT=R1 

TRC 

96 

LK0=3 

TRC 

97 

LRI  =  3 

TRC 

98 

GOTO  300 

TRC 

99 

TRC 

100 

200 

IF(WH)210»3 50*250 

TRC 

101 

210 

IF1VPH.GE.0. JGOTO  350 

TRC 

102 

CP= VPH/WH 

TRC 

103 

F1=CP*CP-2.*CP*VPW+PVPV-RB*KB 

TRC 

104 

IFCF1.GT.0. JGOTO  220 

TRC 

105 

INTSEC=INTSEC+1 

TRC 

106 

R0UT=CP 

TRC 

107 

LR0=1 

TRC 

108 

IFUNTSEC.GE.2JG0T0  300 

TRC 

109 

220 

CM=VPHHH/WH 

TRC 

110 

Fi=CM*CM-2.*( (VPH^WH J*CM-VPH)*HH+PVPV-RT*RT 

TRC 

111 

IF1F1.GT.0. JGOTO  350 

TRC 

112 

R 1 N=CM 

TRC 

113 

LR  1=2 

TRC 

114 

GO  f  0  30-J 

TRC 

115 

250 

1F( VPHHH.LT. 0. JGOTO  350 

TRC 

116 

CP= VPHHH/WH 

TRC 

117 

F l =CP*CP-2 . * ( ( VPW+WH)*CP-VPH)«-HH  +  PVPV-RT*RT 

TRC 

lit) 

IFIFl.GT.O. JGOTO  260 

TRC 

119 

INTSEC= I NTSEC+ 1 

TRC 

120 

ROUT =CP 

TRC 

121 

LRO=? 

TRC 

122 

260 

1F1  INTSEC.GE.2JG0T0  300 

TRC 

123 

CM= VPH/WH 

TRC 

124 

F1=CM*CM-2.*CP*VPW+PVPV~RB*RB 

TKC 

125 

IFIFl.GT.O. JGOTO  350  149 

TRC 

126 
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i 

i 


RIN-CM 

LRI-1 

C 

300  IF ( ABS (ROUT-RIN) -RGUT*1.0E-5 1350,350. 360 
350  RIN*P INF  * 

R0UT*-P1NF 
LRI*0 
LR0«0 

360  RETURN 
END 
t 
C 

END 


TRC 

127 

TRC 

128 

TRC 

129 

TRC 

130 

TRC 

131 

TRC 

132 

TRC 

133 

TRC 

134 

TRC 

135 

TRC 

136 

TRC 

137 

TRC 

138 

TRC 

139 

ISO 


